- 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 Jan 18, 2025@03:47:01 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