DGPMGLG ;ALB/LM - G&L GENERATION, COLLECT DATA, CLEAN UP; 16 JAN 91
;;5.3;Registration;;Aug 13, 1993
;
; Date of G&L and/or Bed Status Report
A S X1=RD,X2=-1 D C^%DTC S (FR,MV)=X_".999999",TO=$P(RD,".",1)_".999999"
F I=0:0 S MV=$O(^DGPM("B",MV)) Q:MV'>0!(MV>TO) F MN=0:0 S MN=$O(^DGPM("B",MV,MN)) Q:'MN I $D(^DGPM(MN,0)) S MD=^(0) D ^DGPMGLG1,^DGPMGLG2,^DGPMGLG3 D ^DGPMBSG:RC
I 'GL,'BS,'TSR Q
K AD,BL,DFN,DPT,J,L,LN,MD,MDP,MV,NLS,X,X1,X2,Y,D,D1,ID,II,INS,INS1,JJ,JJ1,JJ2,NN,TO,FR,TSC,WDC
S UL=$S(('$D(IOST)#2):"-",IOST["C-":"-",1:"_"),IOP=$S($D(ION)#2:ION,1:"HOME")_";"_$S($D(IOM)#2:IOM,1:"")_";"_$S($D(IOSL)#2:IOSL,1:"")
S X=132 X ^%ZOSF("RM")
D ^DGPMGLP:GL,^DGPMBSP:BS,^DGPMTSR:TSR W @IOF Q
;
DONE D CLEAN K RD,TSR,TSRI,DGPM,BS,GL,DGPM,REM,PD,RC,VN,TS,SS,SNM,SF,RM,TSD,CP,MT,OS,NOW,IOP,DGDIV,DGSRV,DIV,DR,PTNAME,UL,YD,NTOTAL,RCR,DGNOW D CLOSE^DGUTQ D ^%ZISC Q
;
CLEAN F I="TOD","CN","CN1","S","S1","SN","SN1","R","R1","NG","FR","6","VN","TV","T6","TF","AA","UA","PS","IP","TA","TP","TI","TU","OD","F","G","D","C","T","DN","RN","RN1","WBD","WNN","WON","WOR","WOS","WTOR" S X="DG"_I K ^UTILITY(X,$J)
K ^UTILITY("DGWPL",$J),^UTILITY("DGWPLT",$J),^UTILITY("DGOD",$J),^UTILITY("DGTOD",$J),^UTILITY("DGAS",$J),^UTILITY("DGTAS",$J)
;
KVAR K %,A,AD,ADC,AT,ATS,BD,BDAY,BL,BO,C,C1,CB,CD,CN,CN1,CT,CUM,CW,D,D1,DA,DB,DC,DD,DFN,DGDOM,DGHEM,DGHX,DGNHCU,DGP,DGPMBO,DGPMDDF,DGPMY,DGSF,DGVT,DIC,DIE,DP,DPT,DV,E,FF,FM,FR,FY,I,I1,I2,I3,ID,II,INS,INS1,RCCK
K J,J1,JJ,JJ1,JJ2,JUS,K,L,LA,LD,LDV,LEG,LN,LT,LTSDV,LW,M,MASD,MASDEV,MD,MDP,MIFN,MN,MV,MW,MW1,MW2,MW3,N,N1,NLS,NN,NN1,NOD,NOW,O,O1,OOS,ORDER
K P,PAG,PARA,PL,POP,PP,PR,PR1,PRC,PRM,PRT,PT,PTS,PTSDV,PW,R,RA,T,T1,T2,T3,TAB,TB,TC,TL,TL1,TN,TO,TSC,TSLD,TSRIPD,TT
K TX,TY,W,W1,W2,WD,WDC,X,X1,X2,X3,XX,XX1,XX2,XX3,Y,Z,Z1,ZMV,ZTDESC,ZTIO,ZTRTN,ZTSAVE
D KVAR^VADPT30
Q
;
VAR ; RD=Report Date ; FR=From Date ; TO=To Date ;
; MV=from start date (Movement date) ; MN=Movement Number ; MD=Movement Data ;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGPMGLG 1990 printed Dec 13, 2024@02:49:37 Page 2
DGPMGLG ;ALB/LM - G&L GENERATION, COLLECT DATA, CLEAN UP; 16 JAN 91
+1 ;;5.3;Registration;;Aug 13, 1993
+2 ;
+3 ; Date of G&L and/or Bed Status Report
A SET X1=RD
SET X2=-1
DO C^%DTC
SET (FR,MV)=X_".999999"
SET TO=$PIECE(RD,".",1)_".999999"
+1 FOR I=0:0
SET MV=$ORDER(^DGPM("B",MV))
if MV'>0!(MV>TO)
QUIT
FOR MN=0:0
SET MN=$ORDER(^DGPM("B",MV,MN))
if 'MN
QUIT
IF $DATA(^DGPM(MN,0))
SET MD=^(0)
DO ^DGPMGLG1
DO ^DGPMGLG2
DO ^DGPMGLG3
if RC
DO ^DGPMBSG
+2 IF 'GL
IF 'BS
IF 'TSR
QUIT
+3 KILL AD,BL,DFN,DPT,J,L,LN,MD,MDP,MV,NLS,X,X1,X2,Y,D,D1,ID,II,INS,INS1,JJ,JJ1,JJ2,NN,TO,FR,TSC,WDC
+4 SET UL=$SELECT(('$DATA(IOST)#2):"-",IOST["C-":"-",1:"_")
SET IOP=$SELECT($DATA(ION)#2:ION,1:"HOME")_";"_$SELECT($DATA(IOM)#2:IOM,1:"")_";"_$SELECT($DATA(IOSL)#2:IOSL,1:"")
+5 SET X=132
XECUTE ^%ZOSF("RM")
+6 if GL
DO ^DGPMGLP
if BS
DO ^DGPMBSP
if TSR
DO ^DGPMTSR
WRITE @IOF
QUIT
+7 ;
DONE DO CLEAN
KILL RD,TSR,TSRI,DGPM,BS,GL,DGPM,REM,PD,RC,VN,TS,SS,SNM,SF,RM,TSD,CP,MT,OS,NOW,IOP,DGDIV,DGSRV,DIV,DR,PTNAME,UL,YD,NTOTAL,RCR,DGNOW
DO CLOSE^DGUTQ
DO ^%ZISC
QUIT
+1 ;
CLEAN FOR I="TOD","CN","CN1","S","S1","SN","SN1","R","R1","NG","FR","6","VN","TV","T6","TF","AA","UA","PS","IP","TA","TP","TI","TU","OD","F","G","D","C","T","DN","RN","RN1","WBD","WNN","WON","WOR","WOS","WTOR"
SET X="DG"_I
KILL ^UTILITY(X,$JOB)
+1 KILL ^UTILITY("DGWPL",$JOB),^UTILITY("DGWPLT",$JOB),^UTILITY("DGOD",$JOB),^UTILITY("DGTOD",$JOB),^UTILITY("DGAS",$JOB),^UTILITY("DGTAS",$JOB)
+2 ;
KVAR KILL %,A,AD,ADC,AT,ATS,BD,BDAY,BL,BO,C,C1,CB,CD,CN,CN1,CT,CUM,CW,D,D1,DA,DB,DC,DD,DFN,DGDOM,DGHEM,DGHX,DGNHCU,DGP,DGPMBO,DGPMDDF,DGPMY,DGSF,DGVT,DIC,DIE,DP,DPT,DV,E,FF,FM,FR,FY,I,I1,I2,I3,ID,II,INS,INS1,RCCK
+1 KILL J,J1,JJ,JJ1,JJ2,JUS,K,L,LA,LD,LDV,LEG,LN,LT,LTSDV,LW,M,MASD,MASDEV,MD,MDP,MIFN,MN,MV,MW,MW1,MW2,MW3,N,N1,NLS,NN,NN1,NOD,NOW,O,O1,OOS,ORDER
+2 KILL P,PAG,PARA,PL,POP,PP,PR,PR1,PRC,PRM,PRT,PT,PTS,PTSDV,PW,R,RA,T,T1,T2,T3,TAB,TB,TC,TL,TL1,TN,TO,TSC,TSLD,TSRIPD,TT
+3 KILL TX,TY,W,W1,W2,WD,WDC,X,X1,X2,X3,XX,XX1,XX2,XX3,Y,Z,Z1,ZMV,ZTDESC,ZTIO,ZTRTN,ZTSAVE
+4 DO KVAR^VADPT30
+5 QUIT
+6 ;
VAR ; RD=Report Date ; FR=From Date ; TO=To Date ;
+1 ; MV=from start date (Movement date) ; MN=Movement Number ; MD=Movement Data ;
