Return to DIFGG.m CVS log

Up to [Coherent Logic Development] / freem_fileman

Annotation of freem_fileman/DIFGG.m, revision 1.1.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