DGODASK ;ALB/EG - INPATIENT/OUTPATIENT MEANS TEST REPORTS ; 27 DEC 88 1146
;;5.3;Registration;;Aug 13, 1993
W !!,*7,"DISCRETIONARY WORKLOAD OPTIONS ARE NO LONGER AVAILABLE!",!! Q
;;V 4.5
S U="^",%=2,DGSAV=0
K ^UTILITY("DGOD",$J)
D LO^DGUTL,ASK S DG05=X Q:DGQ=1 D @DG05
K %,DG01,DG02,DG03,DG04,DG05,DG0BD,DG0ND,%DT,%DT(0),%DT("A"),%DT("B"),DG0Y1,A1,AD,D,DGBD,DGBD1,DGGE,DGJB,DGM,DGMO,DGND,DGNET,DGQ,DGQDT,DGSAV,DGSP,DGTOUT,H1,H2,K1,POP,T2,U,X,Y,Z,ZRT,ZQ,ZTSK,ZTIO
Q
RD S X="" R X:DTIME I X[U!('$T) S DGQ=1 Q
S X=$E(X) Q
ASK S DGQ="" W !!,"Do you wish (I)npatient,(O)utpatient,or (B)oth reports: BOTH// " S Z=U_"INPATIENT^OUTPATIENT^BOTH" D RD I X="" S X="B" W X
D IN^DGHELP S DGSAV=$S(X="B":1,1:0),X=$S(X="B":"DGODOP1,^DGODNP1",X="O":"DGODOP1",X="I":"DGODNP1",X[U:U,1:0) W:X=0 !,"Enter I,O,B, or ^ to QUIT" G:X=0 ASK Q:X=U S X=U_X
Q
;
TRN ;checks to see if run may be broken into months.
S DGM="31^28^31^30^31^30^31^31^30^31^30^31",X2=DGBD,X1=DGND D ^%DTC S DG0Y1=%Y
S DGSP=DG0Y1 S:($E(DGND,1,3)#4=0)!($E(DGBD,1,3)#4=0) $P(DGM,U,2)=29
Q:$E(DGND,1,3)-$E(DGBD,1,3)>1 I $E(DGND,1,3)'=$E(DGBD,1,3) S DG0BD=DGBD,DG0ND=$E(DGBD,1,3)_"1231",DG0I1=0 D TRN1 S DG0BD=$E(DGND,1,3)_"0101",DG0ND=DGND,DG0I1=DG0I D TRN1
I $E(DGND,1,3)=$E(DGBD,1,3) S DG0BD=DGBD,DG0ND=DGND,DG0I1=0 D TRN1
S DG0ND(DG0I1+DG0I)=$E(DG0ND,1,3)_DG0X1_$E(DG0ND,6,7),DG0BD(1)=$E(DG0BD(1),1,5)_$E(DGBD,6,7) F DG0I=1:1 Q:$D(DG0BD(DG0I))=0 D DGMO
S DGSP=DG0I-1 K %DT,DG0I,DG0I1,DG0X,DG0X1,X,X1,X2,Y
Q
TRN1 S DG0X=+$E(DG0BD,4,5),DG0Y1=+$E(DG0ND,4,5)
F DG0I=1:1:DG0Y1-DG0X+1 S DG0X1=DG0X+DG0I-1 S:DG0X1<10 DG0X1="0"_DG0X1 S DG0BD(DG0I1+DG0I)=$E(DG0BD,1,3)_DG0X1_"01",DG0X1=DG0X+DG0I-1 S:DG0X1<10 DG0X1="0"_DG0X1 S DG0ND(DG0I1+DG0I)=$E(DG0ND,1,3)_DG0X1_$P(DGM,U,+DG0X1)
Q
DGMO ;is range large enough for transmission (full month)
S DGMO(DG0I)=$S($E(DG0BD(DG0I),6,7)'="01":0,$E(DG0ND(DG0I),6,7)=$P(DGM,U,$E(DG0ND(DG0I),4,5)):1,1:0)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGODASK 1941 printed Dec 13, 2024@02:46:20 Page 2
DGODASK ;ALB/EG - INPATIENT/OUTPATIENT MEANS TEST REPORTS ; 27 DEC 88 1146
+1 ;;5.3;Registration;;Aug 13, 1993
+2 WRITE !!,*7,"DISCRETIONARY WORKLOAD OPTIONS ARE NO LONGER AVAILABLE!",!!
QUIT
+3 ;;V 4.5
+4 SET U="^"
SET %=2
SET DGSAV=0
+5 KILL ^UTILITY("DGOD",$JOB)
+6 DO LO^DGUTL
DO ASK
SET DG05=X
if DGQ=1
QUIT
DO @DG05
+7 KILL %,DG01,DG02,DG03,DG04,DG05,DG0BD,DG0ND,%DT,%DT(0),%DT("A"),%DT("B"),DG0Y1,A1,AD,D,DGBD,DGBD1,DGGE,DGJB,DGM,DGMO,DGND,DGNET,DGQ,DGQDT,DGSAV,DGSP,DGTOUT,H1,H2,K1,POP,T2,U,X,Y,Z,ZRT,ZQ,ZTSK,ZTIO
+8 QUIT
RD SET X=""
READ X:DTIME
IF X[U!('$TEST)
SET DGQ=1
QUIT
+1 SET X=$EXTRACT(X)
QUIT
ASK SET DGQ=""
WRITE !!,"Do you wish (I)npatient,(O)utpatient,or (B)oth reports: BOTH// "
SET Z=U_"INPATIENT^OUTPATIENT^BOTH"
DO RD
IF X=""
SET X="B"
WRITE X
+1 DO IN^DGHELP
SET DGSAV=$SELECT(X="B":1,1:0)
SET X=$SELECT(X="B":"DGODOP1,^DGODNP1",X="O":"DGODOP1",X="I":"DGODNP1",X[U:U,1:0)
if X=0
WRITE !,"Enter I,O,B, or ^ to QUIT"
if X=0
GOTO ASK
if X=U
QUIT
SET X=U_X
+2 QUIT
+3 ;
TRN ;checks to see if run may be broken into months.
+1 SET DGM="31^28^31^30^31^30^31^31^30^31^30^31"
SET X2=DGBD
SET X1=DGND
DO ^%DTC
SET DG0Y1=%Y
+2 SET DGSP=DG0Y1
if ($EXTRACT(DGND,1,3)#4=0)!($EXTRACT(DGBD,1,3)#4=0)
SET $PIECE(DGM,U,2)=29
+3 if $EXTRACT(DGND,1,3)-$EXTRACT(DGBD,1,3)>1
QUIT
IF $EXTRACT(DGND,1,3)'=$EXTRACT(DGBD,1,3)
SET DG0BD=DGBD
SET DG0ND=$EXTRACT(DGBD,1,3)_"1231"
SET DG0I1=0
DO TRN1
SET DG0BD=$EXTRACT(DGND,1,3)_"0101"
SET DG0ND=DGND
SET DG0I1=DG0I
DO TRN1
+4 IF $EXTRACT(DGND,1,3)=$EXTRACT(DGBD,1,3)
SET DG0BD=DGBD
SET DG0ND=DGND
SET DG0I1=0
DO TRN1
+5 SET DG0ND(DG0I1+DG0I)=$EXTRACT(DG0ND,1,3)_DG0X1_$EXTRACT(DG0ND,6,7)
SET DG0BD(1)=$EXTRACT(DG0BD(1),1,5)_$EXTRACT(DGBD,6,7)
FOR DG0I=1:1
if $DATA(DG0BD(DG0I))=0
QUIT
DO DGMO
+6 SET DGSP=DG0I-1
KILL %DT,DG0I,DG0I1,DG0X,DG0X1,X,X1,X2,Y
+7 QUIT
TRN1 SET DG0X=+$EXTRACT(DG0BD,4,5)
SET DG0Y1=+$EXTRACT(DG0ND,4,5)
+1 FOR DG0I=1:1:DG0Y1-DG0X+1
SET DG0X1=DG0X+DG0I-1
if DG0X1<10
SET DG0X1="0"_DG0X1
SET DG0BD(DG0I1+DG0I)=$EXTRACT(DG0BD,1,3)_DG0X1_"01"
SET DG0X1=DG0X+DG0I-1
if DG0X1<10
SET DG0X1="0"_DG0X1
SET DG0ND(DG0I1+DG0I)=$EXTRACT(DG0ND,1,3)_DG0X1_$PIECE(DGM,U,+DG0X1)
+2 QUIT
DGMO ;is range large enough for transmission (full month)
+1 SET DGMO(DG0I)=$SELECT($EXTRACT(DG0BD(DG0I),6,7)'="01":0,$EXTRACT(DG0ND(DG0I),6,7)=$PIECE(DGM,U,$EXTRACT(DG0ND(DG0I),4,5)):1,1:0)
+2 QUIT
