Return to DIFGG.m CVS log

Up to [Coherent Logic Development] / freem_fileman

Annotation of freem_fileman/DIFGG.m, revision 1.1

1.1     ! snw         1: DIFGG  ;SFISC/XAK,EDE(OHPRD)-FILEGRAM GENERATOR ;7/25/92  2:15 PM
        !             2:        ;;21.0;VA FileMan;;Dec 28, 1994
        !             3:        ;Per VHA Directive 10-93-142, this routine should not be modified.
        !             4:        K DIFG S DIFG=DIC,DIC("A")="Select FILEGRAM TEMPLATE: "
        !             5:        S DK=+Y,DIC="^DIPT(",DIC("S")="I $P(^(0),U,8)=1 S %=^(0) I $P(%,U,4)=DK!'$L($P(%,U,4))",DIC(0)="QEAIS",D="F"_+Y
        !             6:        D IX^DIC K DIC,DY Q:Y<0  S (DIFG("TEMPLATE"),DIFGT)=+Y
        !             7:        S DIC=DIFG,DIC(0)="QEAM" D ^DIC Q:Y<0  S DIFG("FE")=+Y,DIFG("FUNC")="L",DIFG("DUZ")=$S($D(^VA(200,DUZ,0)):$P(^(0),U),$D(^DIC(3,DUZ,0)):$P(^(0),U),1:DUZ)
        !             8:        D START,SEND,LOG K DIFG,^UTILITY("DIFG",$J) Q
        !             9:        ;
        !            10: EN     ; EXTERNAL ENTRY POINT
        !            11: START  ;
        !            12:        D INIT
        !            13:        I DIFG("QFLG") D EOJ Q
        !            14:        D HDR,ENV,BODY,TLR,EOJ
        !            15:        Q
        !            16:        ;
        !            17: HDR    ; FILEGRAM HEADER
        !            18:        S V="$DAT"_U_DIFG(DILL,"FNAME")_U_DIFG(DILL,"FILE")_U_DIFG("PARM")_U
        !            19:        D INCSET^DIFGGU
        !            20:        K Y Q
        !            21:        ;
        !            22: ENV    ; ENVIRONMENTAL VARS
        !            23:        I $D(DIFG("ENV"))
        !            24:        E  Q
        !            25:        S DIFG("EV")=""
        !            26:        F  S DIFG("EV")=$O(DIFG("ENV",DIFG("EV"))) Q:DIFG("EV")=""  S V="ENVIRONMENT:"_DIFG("EV")_"="""_DIFG("ENV",DIFG("EV"))_"""" D INCSET^DIFGGU ;ihs/ohprd/dg;patch 2;8-22-91
        !            27:        K DIFG("EV") Q
        !            28:        ;
        !            29: BODY   ; FILEGRAM BODY
        !            30:        D BASE
        !            31:        K DIFG("NOKEY")
        !            32:        D NEXTLVL
        !            33:        Q
        !            34:        ;
        !            35: BASE   ; BASEFILE ENTRY
        !            36:        D LOOKUP^DIFGGU
        !            37:        D FIELDS
        !            38:        Q
        !            39:        ;
        !            40: NEXTLVL        ; DO NEXT LEVEL FILES/SUBFILES (CALLED RECURSIVELY)
        !            41:        S DIFG(DILL,"DIFGI")=DIFGI
        !            42:        S DILL=DILL+1
        !            43:        F DIFGI=DIFGI:0 S DIFGI=$O(^DIPT(DIFGT,1,DIFGI)) Q:DIFGI'=+DIFGI  S X=^(DIFGI,0) D NEXTLVL2 Q:DIFGI=""
        !            44:        S DILL=DILL-1
        !            45:        S DIFGI=DIFG(DILL,"DIFGI")
        !            46:        Q
        !            47:        ;
        !            48: NEXTLVL2       ; CHECK TEMPLATE ENTRY
        !            49:        I $P(X,U,2)<DILL S DIFGI="" Q
        !            50:        Q:$P(X,U,3)'=DIFG(DILL-1,"FILE")  ; this is probably a template error
        !            51:        D FVARS^DIFGGI
        !            52:        I DIFG(DILL,"XREF")?1A.E D DIFGG3^DIFGG4 Q  ; file shift
        !            53:        I DIFG(DILL,"XREF")=3 D ^DIFGG4 Q  ; subfile shift
        !            54:        Q:'DIFG(DILL,"FE")
        !            55:        ; only things left are dinum back pointers, direct forward pointers,
        !            56:        ; and lookup file shifts, I think.
        !            57:        D LOOKUP^DIFGGU
        !            58:        I $D(DIFGGUQ) K DIFGGUQ Q
        !            59:        D FIELDS
        !            60:        D RECURSE
        !            61:        S DITAB=2*(DILL-1)
        !            62:        S V=":" D INCSET^DIFGGU
        !            63:        Q
        !            64:        ;
        !            65: RECURSE        ; RECURSION FOR DINUM BACK POINTERS AND FORWARD DIRECT POINTERS
        !            66:        D NEXTLVL
        !            67:        Q
        !            68:        ;
        !            69: FIELDS ; FILEGRAM FIELDS
        !            70:        S DITAB=DITAB+2 D ^DIFGG2 S DITAB=DITAB-2
        !            71:        Q
        !            72:        ;
        !            73: LOG    ; RECORD THE SENDING
        !            74:        Q:$D(DIAR)!$D(DY)
        !            75:        S DIC=1.12,X="NOW",DIC(0)="L",DLAYGO=1.12,DIADD=1 D ^DIC Q:Y<0  G LOG:'$P(Y,U,3)
        !            76:        S ^DIAR(1.12,+Y,0)=$P(Y,U,2)_"^s^"_DIFG("DUZ")_U_DIFG_U_DIFG("FE")_U_XMZ_U_DIFG("TEMPLATE")
        !            77:        K DIC,DIE,DR,DA,DLAYGO,DIADD,XMZ
        !            78:        Q
        !            79:        ;
        !            80:        ;
        !            81: SEND   ; CALL MAILMAN
        !            82:        Q:$D(DIAR)!$D(DY)
        !            83:        S XMSUB="FILEGRAM for entry #"_DIFG("FE")_" in "_$O(^DD(DIFG,0,"NM",0))_" FILE (#"_DIFG_")."
        !            84:        S XMTEXT=DIFG("FGR"),XMDUZ=DUZ D ^XMD
        !            85:        Q
        !            86:        ;
        !            87: TLR    ; FILEGRAM TRAILER
        !            88:        S V="$END DAT",DITAB=0
        !            89:        D INCSET^DIFGGU
        !            90:        Q
        !            91:        ;
        !            92: INIT   ; INITIALIZATION
        !            93:        D ^DIFGGI
        !            94:        Q
        !            95:        ;
        !            96: EOJ    ;
        !            97:        S:DIFG("QFLG") DIFGER=DIFG("QFLG")
        !            98:        F I=0:0 S I=$O(DIFG(I)) Q:I'=+I  K DIFG(I)
        !            99:        K ^UTILITY("DIFGLINK",$J)
        !           100:        K DIFG2,DIFGI,DIFGT,DILL,DITAB,DIFGENV,DIFGGU,DIFGGF ;Don't kill DILC used by EN^DIFGG;ihs/ohprd/dwg;patch 2;8-22-91
        !           101:        K %H,%K,%W,S,V,X
        !           102:        Q