Return to DIFGG.m CVS log

Up to [Coherent Logic Development] / freem_fileman / USER

Restructure repository

    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