- DGPMGLG ;ALB/LM - G&L GENERATION, COLLECT DATA, CLEAN UP; 16 JAN 91
- ;;5.3;Registration;**1015**;Aug 13, 1993;Build 21
- ;
- ; 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 ;
- DGPMGLG ;ALB/LM - G&L GENERATION, COLLECT DATA, CLEAN UP; 16 JAN 91
- +1 ;;5.3;Registration;**1015**;Aug 13, 1993;Build 21
- +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 ;
