DGODOP2 ;ALB/EG - OUTPUT TOT VISITS,CAT B&C, NON-VETS FROM OPC FILE ; JAN 9 1989 @ 1507
;;5.3;Registration;;Aug 13, 1993
;;V 4.5
S U="^",ZRT=1,%DT="T",X="N" D ^%DT S (T2,DGGE)=Y X ^DD("DD") S T2=Y
S I5("V")="SC 50-100%^A&A/HB/WW1/POW/MEX^SC<50%^NSC/PEN^NSC^DOM^",I5("N")="CHAMPVA^COLLATERAL^EMPLOYEE^OTHER FED^ALLIED VET^HUMANITARIAN^SHARING^REIMB INSURANCE^"
D ET^DGODUTL F K=1:1:A2 Q:ZRT[U F K1=1:1:DGTN Q:ZRT[U D PRI,TOTO^DGODTOT
D ^DGODOSM W !,?1,"Elapsed time for this run: ",DGTOUT,!
END K DGDV,DGEL,DGGE,DGTOUT,I,I1,I2,I3,I5,K,L,T2,X,Y,ZRT,ZRT1 Q
PRI Q:ZRT[U S DGDV=$E($P(A(K),U,2)_" ",1,5) Q:^UTILITY("DGOD",$J,DGJB,K1,"TOT",DGDV)=0 D HDR W !,?1,"DIVISION: ",$P(A(K),U,2),?20,$P(A(K),U,1),?40,"TOTAL VISITS: ",?50,^UTILITY("DGOD",$J,DGJB,K1,"TOT",DGDV),!
W !,?30,"AS",?40,"AN",?50,"B0",?60,"C0",?70,"N0",?80,"X0",?90,"U0",?100,"TOTAL",?110,"%",!
F I=30:10:110 W ?I,"------"
F I1="V","N" W !,?1,$S(I1="V":"VETERAN ELIGIBILITY",I1="N":"NON-VETERAN ELIGIBILITY",1:0),!,?1,"-----------------------",! F I2=1:1:8,"*" Q:ZRT[U D PRI1
Q
PRI1 ;print each row
S ZRT1="Hit RETURN to continue" I (IOST["C-")&(IO=IO(0))&(IOSL-$Y<4) W !,?IOM-$L(ZRT1)-2,ZRT1 R ZRT:DTIME S:'$T ZRT=U D:$D(ZRT) HDR Q:ZRT[U
W:'((I1="V")&(I2>6)) !,?1,$P(I5(I1),U,I2)
W:I2="*" ?1,"ERROR"
W:'((I1="V")&(I2>6)) ?30,^UTILITY("DGOD",$J,DGJB,K1,DGDV,I1,"AS",I2),?40,^UTILITY("DGOD",$J,DGJB,K1,DGDV,I1,"AN",I2),?50,^UTILITY("DGOD",$J,DGJB,K1,DGDV,I1,"B",I2),?60,^UTILITY("DGOD",$J,DGJB,K1,DGDV,I1,"C",I2)
W:'((I1="V")&(I2>6)) ?70,^UTILITY("DGOD",$J,DGJB,K1,DGDV,I1,"N",I2),?80,^UTILITY("DGOD",$J,DGJB,K1,DGDV,I1,"X",I2),?90,^UTILITY("DGOD",$J,DGJB,K1,DGDV,I1,"U",I2)
W:'((I1="V")&(I2>6)) ?100,^UTILITY("DGOD",$J,DGJB,K1,DGDV,I1,"TOT",I2),?110,"("_$J(^UTILITY("DGOD",$J,DGJB,K1,DGDV,I1,"TOT",I2)/^UTILITY("DGOD",$J,DGJB,K1,"TOT",DGDV)*100,2,2)_")",!
D:I2="*" TOT1
Q
;
TOT1 ;print subtotal
Q:ZRT[U F I=30:10:110 W ?I,"------"
W !,?1,"SUBTOTAL",?30,^UTILITY("DGOD",$J,DGJB,K1,DGDV,I1,"TOT","AS"),?40,^("AN"),?50,^("B"),?60,^("C"),?70,^("N"),?80,^("X"),?90,^("U")
W ?100,^UTILITY("DGOD",$J,DGJB,K1,DGDV,"TOT",I1),?110,"("_$J(^UTILITY("DGOD",$J,DGJB,K1,DGDV,"TOT",I1)/^UTILITY("DGOD",$J,DGJB,K1,"TOT",DGDV)*100,2,2)_")"
W !,?1,"SUBTOTAL %",?30,$J(^UTILITY("DGOD",$J,DGJB,K1,DGDV,I1,"TOT","AS")/^UTILITY("DGOD",$J,DGJB,K1,"TOT",DGDV)*100,2,2),?40,$J(^UTILITY("DGOD",$J,DGJB,K1,DGDV,I1,"TOT","AN")/^UTILITY("DGOD",$J,DGJB,K1,"TOT",DGDV)*100,2,2)
W ?50,$J(^UTILITY("DGOD",$J,DGJB,K1,DGDV,I1,"TOT","B")/^UTILITY("DGOD",$J,DGJB,K1,"TOT",DGDV)*100,2,2),?60,$J(^UTILITY("DGOD",$J,DGJB,K1,DGDV,I1,"TOT","C")/^UTILITY("DGOD",$J,DGJB,K1,"TOT",DGDV)*100,2,2)
W ?70,$J(^UTILITY("DGOD",$J,DGJB,K1,DGDV,I1,"TOT","N")/^UTILITY("DGOD",$J,DGJB,K1,"TOT",DGDV)*100,2,2),?80,$J(^UTILITY("DGOD",$J,DGJB,K1,DGDV,I1,"TOT","X")/^UTILITY("DGOD",$J,DGJB,K1,"TOT",DGDV)*100,2,2)
W ?90,$J(^UTILITY("DGOD",$J,DGJB,K1,DGDV,I1,"TOT","U")/^UTILITY("DGOD",$J,DGJB,K1,"TOT",DGDV)*100,2,2)
W ?100,$J(^UTILITY("DGOD",$J,DGJB,K1,DGDV,"TOT",I1)/^UTILITY("DGOD",$J,DGJB,K1,"TOT",DGDV)*100,2,2),!
Q
;
HDR U IO W @IOF,!,?1,$P($T(TXT+K1),";;",2),?IOM-20,T2 S $P(L,"-",IOM-1)="" W !,L,!
W !,?1,"DATE RANGE: FROM " S Y=DGBD X ^DD("DD") W Y," TO " S Y=DGND X ^DD("DD") W Y,!
W !,?(IOM-26\2),"MEANS TEST CLASSIFICATION",!
Q
;
TXT ;;
;;OUTPATIENT VISIT WORKLOAD REPORT
;;OUTPATIENT 10/10 VISIT WORKLOAD REPORT
;;OUTPATIENT VISIT - RESEARCH WORKLOAD REPORT
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGODOP2 3462 printed Nov 22, 2024@17:56:26 Page 2
DGODOP2 ;ALB/EG - OUTPUT TOT VISITS,CAT B&C, NON-VETS FROM OPC FILE ; JAN 9 1989 @ 1507
+1 ;;5.3;Registration;;Aug 13, 1993
+2 ;;V 4.5
+3 SET U="^"
SET ZRT=1
SET %DT="T"
SET X="N"
DO ^%DT
SET (T2,DGGE)=Y
XECUTE ^DD("DD")
SET T2=Y
+4 SET I5("V")="SC 50-100%^A&A/HB/WW1/POW/MEX^SC<50%^NSC/PEN^NSC^DOM^"
SET I5("N")="CHAMPVA^COLLATERAL^EMPLOYEE^OTHER FED^ALLIED VET^HUMANITARIAN^SHARING^REIMB INSURANCE^"
+5 DO ET^DGODUTL
FOR K=1:1:A2
if ZRT[U
QUIT
FOR K1=1:1:DGTN
if ZRT[U
QUIT
DO PRI
DO TOTO^DGODTOT
+6 DO ^DGODOSM
WRITE !,?1,"Elapsed time for this run: ",DGTOUT,!
END KILL DGDV,DGEL,DGGE,DGTOUT,I,I1,I2,I3,I5,K,L,T2,X,Y,ZRT,ZRT1
QUIT
PRI if ZRT[U
QUIT
SET DGDV=$EXTRACT($PIECE(A(K),U,2)_" ",1,5)
if ^UTILITY("DGOD",$JOB,DGJB,K1,"TOT",DGDV)=0
QUIT
DO HDR
WRITE !,?1,"DIVISION: ",$PIECE(A(K),U,2),?20,$PIECE(A(K),U,1),?40,"TOTAL VISITS: ",?50,^UTILITY("DGOD",$JOB,DGJB,K1,"TOT",DGDV),!
+1 WRITE !,?30,"AS",?40,"AN",?50,"B0",?60,"C0",?70,"N0",?80,"X0",?90,"U0",?100,"TOTAL",?110,"%",!
+2 FOR I=30:10:110
WRITE ?I,"------"
+3 FOR I1="V","N"
WRITE !,?1,$SELECT(I1="V":"VETERAN ELIGIBILITY",I1="N":"NON-VETERAN ELIGIBILITY",1:0),!,?1,"-----------------------",!
FOR I2=1:1:8,"*"
if ZRT[U
QUIT
DO PRI1
+4 QUIT
PRI1 ;print each row
+1 SET ZRT1="Hit RETURN to continue"
IF (IOST["C-")&(IO=IO(0))&(IOSL-$Y<4)
WRITE !,?IOM-$LENGTH(ZRT1)-2,ZRT1
READ ZRT:DTIME
if '$TEST
SET ZRT=U
if $DATA(ZRT)
DO HDR
if ZRT[U
QUIT
+2 if '((I1="V")&(I2>6))
WRITE !,?1,$PIECE(I5(I1),U,I2)
+3 if I2="*"
WRITE ?1,"ERROR"
+4 if '((I1="V")&(I2>6))
WRITE ?30,^UTILITY("DGOD",$JOB,DGJB,K1,DGDV,I1,"AS",I2),?40,^UTILITY("DGOD",$JOB,DGJB,K1,DGDV,I1,"AN",I2),?50,^UTILITY("DGOD",$JOB,DGJB,K1,DGDV,I1,"B",I2),?60,^UTILITY("DGOD",$JOB,DGJB,K1,DGDV,I1,"C",I2)
+5 if '((I1="V")&(I2>6))
WRITE ?70,^UTILITY("DGOD",$JOB,DGJB,K1,DGDV,I1,"N",I2),?80,^UTILITY("DGOD",$JOB,DGJB,K1,DGDV,I1,"X",I2),?90,^UTILITY("DGOD",$JOB,DGJB,K1,DGDV,I1,"U",I2)
+6 if '((I1="V")&(I2>6))
WRITE ?100,^UTILITY("DGOD",$JOB,DGJB,K1,DGDV,I1,"TOT",I2),?110,"("_$JUSTIFY(^UTILITY("DGOD",$JOB,DGJB,K1,DGDV,I1,"TOT",I2)/^UTILITY("DGOD",$JOB,DGJB,K1,"TOT",DGDV)*100,2,2)_")",!
+7 if I2="*"
DO TOT1
+8 QUIT
+9 ;
TOT1 ;print subtotal
+1 if ZRT[U
QUIT
FOR I=30:10:110
WRITE ?I,"------"
+2 WRITE !,?1,"SUBTOTAL",?30,^UTILITY("DGOD",$JOB,DGJB,K1,DGDV,I1,"TOT","AS"),?40,^("AN"),?50,^("B"),?60,^("C"),?70,^("N"),?80,^("X"),?90,^("U")
+3 WRITE ?100,^UTILITY("DGOD",$JOB,DGJB,K1,DGDV,"TOT",I1),?110,"("_$JUSTIFY(^UTILITY("DGOD",$JOB,DGJB,K1,DGDV,"TOT",I1)/^UTILITY("DGOD",$JOB,DGJB,K1,"TOT",DGDV)*100,2,2)_")"
+4 WRITE !,?1,"SUBTOTAL %",?30,$JUSTIFY(^UTILITY("DGOD",$JOB,DGJB,K1,DGDV,I1,"TOT","AS")/^UTILITY("DGOD",$JOB,DGJB,K1,"TOT",DGDV)*100,2,2),?40,$JUSTIFY(^UTILITY("DGOD",$JOB,DGJB,K1,DGDV,I1,"TOT","AN")/^UTILITY("DGOD",$JOB,DGJB,K1,"TOT",DGDV)*100,2
,2)
+5 WRITE ?50,$JUSTIFY(^UTILITY("DGOD",$JOB,DGJB,K1,DGDV,I1,"TOT","B")/^UTILITY("DGOD",$JOB,DGJB,K1,"TOT",DGDV)*100,2,2),?60,$JUSTIFY(^UTILITY("DGOD",$JOB,DGJB,K1,DGDV,I1,"TOT","C")/^UTILITY("DGOD",$JOB,DGJB,K1,"TOT",DGDV)*100,2,2)
+6 WRITE ?70,$JUSTIFY(^UTILITY("DGOD",$JOB,DGJB,K1,DGDV,I1,"TOT","N")/^UTILITY("DGOD",$JOB,DGJB,K1,"TOT",DGDV)*100,2,2),?80,$JUSTIFY(^UTILITY("DGOD",$JOB,DGJB,K1,DGDV,I1,"TOT","X")/^UTILITY("DGOD",$JOB,DGJB,K1,"TOT",DGDV)*100,2,2)
+7 WRITE ?90,$JUSTIFY(^UTILITY("DGOD",$JOB,DGJB,K1,DGDV,I1,"TOT","U")/^UTILITY("DGOD",$JOB,DGJB,K1,"TOT",DGDV)*100,2,2)
+8 WRITE ?100,$JUSTIFY(^UTILITY("DGOD",$JOB,DGJB,K1,DGDV,"TOT",I1)/^UTILITY("DGOD",$JOB,DGJB,K1,"TOT",DGDV)*100,2,2),!
+9 QUIT
+10 ;
HDR USE IO
WRITE @IOF,!,?1,$PIECE($TEXT(TXT+K1),";;",2),?IOM-20,T2
SET $PIECE(L,"-",IOM-1)=""
WRITE !,L,!
+1 WRITE !,?1,"DATE RANGE: FROM "
SET Y=DGBD
XECUTE ^DD("DD")
WRITE Y," TO "
SET Y=DGND
XECUTE ^DD("DD")
WRITE Y,!
+2 WRITE !,?(IOM-26\2),"MEANS TEST CLASSIFICATION",!
+3 QUIT
+4 ;
TXT ;;
+1 ;;OUTPATIENT VISIT WORKLOAD REPORT
+2 ;;OUTPATIENT 10/10 VISIT WORKLOAD REPORT
+3 ;;OUTPATIENT VISIT - RESEARCH WORKLOAD REPORT
