Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: DIFGG

DIFGG.m

Go to the documentation of this file.
  1. DIFGG ;SFISC/XAK,EDE(OHPRD)-FILEGRAM GENERATOR ;7/25/92 2:15 PM
  1. ;;22.2;VA FileMan;;Jan 05, 2016;Build 42
  1. ;;Per VA Directive 6402, this routine should not be modified.
  1. ;;Submitted to OSEHRA 5 January 2015 by the VISTA Expertise Network.
  1. ;;Based on Medsphere Systems Corporation's MSC FileMan 1051.
  1. ;;Licensed under the terms of the Apache License, Version 2.0.
  1. ;
  1. K DIFG S DIFG=DIC,DIC("A")="Select FILEGRAM TEMPLATE: "
  1. 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
  1. D IX^DIC K DIC,DY Q:Y<0 S (DIFG("TEMPLATE"),DIFGT)=+Y
  1. 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)
  1. D START,SEND,LOG K DIFG,^UTILITY("DIFG",$J) Q
  1. ;
  1. EN ; EXTERNAL ENTRY POINT
  1. START ;
  1. D INIT
  1. I DIFG("QFLG") D EOJ Q
  1. D HDR,ENV,BODY,TLR,EOJ
  1. Q
  1. ;
  1. HDR ; FILEGRAM HEADER
  1. S V="$DAT"_U_DIFG(DILL,"FNAME")_U_DIFG(DILL,"FILE")_U_DIFG("PARM")_U
  1. D INCSET^DIFGGU
  1. K Y Q
  1. ;
  1. ENV ; ENVIRONMENTAL VARS
  1. I $D(DIFG("ENV"))
  1. E Q
  1. S DIFG("EV")=""
  1. 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
  1. K DIFG("EV") Q
  1. ;
  1. BODY ; FILEGRAM BODY
  1. D BASE
  1. K DIFG("NOKEY")
  1. D NEXTLVL
  1. Q
  1. ;
  1. BASE ; BASEFILE ENTRY
  1. D LOOKUP^DIFGGU
  1. D FIELDS
  1. Q
  1. ;
  1. NEXTLVL ; DO NEXT LEVEL FILES/SUBFILES (CALLED RECURSIVELY)
  1. S DIFG(DILL,"DIFGI")=DIFGI
  1. S DILL=DILL+1
  1. F DIFGI=DIFGI:0 S DIFGI=$O(^DIPT(DIFGT,1,DIFGI)) Q:DIFGI'=+DIFGI S X=^(DIFGI,0) D NEXTLVL2 Q:DIFGI=""
  1. S DILL=DILL-1
  1. S DIFGI=DIFG(DILL,"DIFGI")
  1. Q
  1. ;
  1. NEXTLVL2 ; CHECK TEMPLATE ENTRY
  1. I $P(X,U,2)<DILL S DIFGI="" Q
  1. Q:$P(X,U,3)'=DIFG(DILL-1,"FILE") ; this is probably a template error
  1. D FVARS^DIFGGI
  1. I DIFG(DILL,"XREF")?1A.E D DIFGG3^DIFGG4 Q ; file shift
  1. I DIFG(DILL,"XREF")=3 D ^DIFGG4 Q ; subfile shift
  1. Q:'DIFG(DILL,"FE")
  1. ; only things left are dinum back pointers, direct forward pointers,
  1. ; and lookup file shifts, I think.
  1. D LOOKUP^DIFGGU
  1. I $D(DIFGGUQ) K DIFGGUQ Q
  1. D FIELDS
  1. D RECURSE
  1. S DITAB=2*(DILL-1)
  1. S V=":" D INCSET^DIFGGU
  1. Q
  1. ;
  1. RECURSE ; RECURSION FOR DINUM BACK POINTERS AND FORWARD DIRECT POINTERS
  1. D NEXTLVL
  1. Q
  1. ;
  1. FIELDS ; FILEGRAM FIELDS
  1. S DITAB=DITAB+2 D ^DIFGG2 S DITAB=DITAB-2
  1. Q
  1. ;
  1. LOG ; RECORD THE SENDING
  1. Q:$D(DIAR)!$D(DY)
  1. 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)
  1. S ^DIAR(1.12,+Y,0)=$P(Y,U,2)_"^s^"_DIFG("DUZ")_U_DIFG_U_DIFG("FE")_U_XMZ_U_DIFG("TEMPLATE")
  1. K DIC,DIE,DR,DA,DLAYGO,DIADD,XMZ
  1. Q
  1. ;
  1. ;
  1. SEND ; CALL MAILMAN
  1. Q:$D(DIAR)!$D(DY)
  1. S XMSUB="FILEGRAM for entry #"_DIFG("FE")_" in "_$O(^DD(DIFG,0,"NM",0))_" FILE (#"_DIFG_")."
  1. S XMTEXT=DIFG("FGR"),XMDUZ=DUZ D ^XMD
  1. Q
  1. ;
  1. TLR ; FILEGRAM TRAILER
  1. S V="$END DAT",DITAB=0
  1. D INCSET^DIFGGU
  1. Q
  1. ;
  1. INIT ; INITIALIZATION
  1. D ^DIFGGI
  1. Q
  1. ;
  1. EOJ ;
  1. S:DIFG("QFLG") DIFGER=DIFG("QFLG")
  1. F I=0:0 S I=$O(DIFG(I)) Q:I'=+I K DIFG(I)
  1. K ^UTILITY("DIFGLINK",$J)
  1. 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
  1. K %H,%K,%W,S,V,X
  1. Q