- DGODNP2 ;ALB/EG - OUTPUT TOT DISCH BY MEANS TST/ELIGIBILITY; JAN 9 1989 @ 1507
- ;;5.3;Registration;**1015**;Aug 13, 1993;Build 21
- ;;V 4.5
- S U="^",ZRT=0,%DT="T",X="N" D ^%DT S (DGGE,T2)=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 S DGDV=$P(A(K),U,2),DGDVN=$P(A(K),U,1),^UTILITY("DGOD",$J,DGJB,DGTN,DGDV,"HOSP")=$S($D(Z(DGDV))>0:Z(DGDV),1:0) Q:ZRT[U D PRI
- D ^DGODNSM W !,"Elapsed time for this run: ",DGTOUT,!
- END K DGBD,DGDV,DGDVN,DGEL,DGG,DGND,DGTOUT,DGV,I,I2,I3,I5,L,T2,X,Y,Z,ZRT,ZRT1
- Q
- HDR U IO W @IOF,!,?1,"INPATIENT DISCHARGES REPORT",?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
- PRI Q:ZRT[U Q:$D(^UTILITY("DGOD",$J,DGJB,DGTN,"TOT",DGDV))=0
- Q:^UTILITY("DGOD",$J,DGJB,DGTN,"TOT",DGDV)=0
- D HDR W !,?1,"FACILITY: ",DGDV,?20,DGDVN,?40,"TOTAL DISCHARGES: ",?50,^UTILITY("DGOD",$J,DGJB,DGTN,"TOT",DGDV)
- W:$D(^UTILITY("DGOD",$J,DGJB,DGTN,DGDV,"HOSP"))>0 ?65,"Patients remaining on "_T2_" : ",^UTILITY("DGOD",$J,DGJB,DGTN,DGDV,"HOSP"),!
- 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 DGV="V","N" W !,?1,$S(DGV="V":"VETERAN ELIGIBILITY",DGV="N":"NON-VETERAN ELIGIBILITY",1:0),!,?1,"-----------------------",! F DGEL=1:1:8,"*" D PRI1
- S:$D(Z(DGDV))=0 Z(DGDV)=0 D:^UTILITY("DGOD",$J,DGJB,DGTN,"TOT",DGDV)>0 TOTI^DGODTOT S ^UTILITY("DGOD",$J,DGJB,DGTN,DGDV)=$C(35)_U_DGGE_U_DGDV_U_DGJB_U_DGBD_U_DGND_U_Z(DGDV)_U_DGTOUT Q
- PRI1 ;print each row
- Q:ZRT[U 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
- W:'((DGV="V")&(DGEL>6)) !,?1,$P(I5(DGV),U,DGEL)
- W:DGEL="*" ?1,"ERROR"
- W:'((DGV="V")&(DGEL>6)) ?30,^UTILITY("DGOD",$J,DGJB,DGTN,DGDV,DGV,"AS",DGEL),?40,^UTILITY("DGOD",$J,DGJB,DGTN,DGDV,DGV,"AN",DGEL),?50,^UTILITY("DGOD",$J,DGJB,DGTN,DGDV,DGV,"B",DGEL),?60,^UTILITY("DGOD",$J,DGJB,DGTN,DGDV,DGV,"C",DGEL)
- W:'((DGV="V")&(DGEL>6)) ?70,^UTILITY("DGOD",$J,DGJB,DGTN,DGDV,DGV,"N",DGEL),?80,^UTILITY("DGOD",$J,DGJB,DGTN,DGDV,DGV,"X",DGEL),?90,^UTILITY("DGOD",$J,DGJB,DGTN,DGDV,DGV,"U",DGEL)
- W:'((DGV="V")&(DGEL>6)) ?100,^UTILITY("DGOD",$J,DGJB,DGTN,DGDV,DGV,"TOT",DGEL),?110,"("_$J(^UTILITY("DGOD",$J,DGJB,DGTN,DGDV,DGV,"TOT",DGEL)/^UTILITY("DGOD",$J,DGJB,DGTN,"TOT",DGDV)*100,2,2)_")",!
- D:DGEL="*" TOT1
- Q
- ;
- TOT1 ;column subtotal
- Q:ZRT[U F I=30:10:110 W ?I,"------"
- W !,?1,"SUBTOTAL",?30,^UTILITY("DGOD",$J,DGJB,DGTN,DGDV,DGV,"TOT","AS"),?40,^("AN"),?50,^("B"),?60,^("C"),?70,^("N"),?80,^("X"),?90,^("U")
- W ?100,^UTILITY("DGOD",$J,DGJB,DGTN,DGDV,"TOT",DGV),?110,"("_$J(^UTILITY("DGOD",$J,DGJB,DGTN,DGDV,"TOT",DGV)/^UTILITY("DGOD",$J,DGJB,DGTN,"TOT",DGDV)*100,2,2)_")"
- W !,?1,"SUBTOTAL %",?30,$J(^UTILITY("DGOD",$J,DGJB,DGTN,DGDV,DGV,"TOT","AS")/^UTILITY("DGOD",$J,DGJB,DGTN,"TOT",DGDV)*100,2,2),?40,$J(^UTILITY("DGOD",$J,DGJB,DGTN,DGDV,DGV,"TOT","AN")/^UTILITY("DGOD",$J,DGJB,DGTN,"TOT",DGDV)*100,2,2)
- W ?50,$J(^UTILITY("DGOD",$J,DGJB,DGTN,DGDV,DGV,"TOT","B")/^UTILITY("DGOD",$J,DGJB,DGTN,"TOT",DGDV)*100,2,2),?60,$J(^UTILITY("DGOD",$J,DGJB,DGTN,DGDV,DGV,"TOT","C")/^UTILITY("DGOD",$J,DGJB,DGTN,"TOT",DGDV)*100,2,2)
- W ?70,$J(^UTILITY("DGOD",$J,DGJB,DGTN,DGDV,DGV,"TOT","N")/^UTILITY("DGOD",$J,DGJB,DGTN,"TOT",DGDV)*100,2,2),?80,$J(^UTILITY("DGOD",$J,DGJB,DGTN,DGDV,DGV,"TOT","X")/^UTILITY("DGOD",$J,DGJB,DGTN,"TOT",DGDV)*100,2,2)
- W ?90,$J(^UTILITY("DGOD",$J,DGJB,DGTN,DGDV,DGV,"TOT","U")/^UTILITY("DGOD",$J,DGJB,DGTN,"TOT",DGDV)*100,2,2)
- W ?100,$J(^UTILITY("DGOD",$J,DGJB,DGTN,DGDV,"TOT",DGV)/^UTILITY("DGOD",$J,DGJB,DGTN,"TOT",DGDV)*100,2,2),!
- Q
- ;
- DGODNP2 ;ALB/EG - OUTPUT TOT DISCH BY MEANS TST/ELIGIBILITY; JAN 9 1989 @ 1507
- +1 ;;5.3;Registration;**1015**;Aug 13, 1993;Build 21
- +2 ;;V 4.5
- +3 SET U="^"
- SET ZRT=0
- SET %DT="T"
- SET X="N"
- DO ^%DT
- SET (DGGE,T2)=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
- SET DGDV=$PIECE(A(K),U,2)
- SET DGDVN=$PIECE(A(K),U,1)
- SET ^UTILITY("DGOD",$JOB,DGJB,DGTN,DGDV,"HOSP")=$SELECT($DATA(Z(DGDV))>0:Z(DGDV),1:0)
- IF ZRT[U
- QUIT
- DO PRI
- +6 DO ^DGODNSM
- WRITE !,"Elapsed time for this run: ",DGTOUT,!
- END KILL DGBD,DGDV,DGDVN,DGEL,DGG,DGND,DGTOUT,DGV,I,I2,I3,I5,L,T2,X,Y,Z,ZRT,ZRT1
- +1 QUIT
- HDR USE IO
- WRITE @IOF,!,?1,"INPATIENT DISCHARGES REPORT",?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",!
- QUIT
- PRI IF ZRT[U
- QUIT
- IF $DATA(^UTILITY("DGOD",$JOB,DGJB,DGTN,"TOT",DGDV))=0
- QUIT
- +1 IF ^UTILITY("DGOD",$JOB,DGJB,DGTN,"TOT",DGDV)=0
- QUIT
- +2 DO HDR
- WRITE !,?1,"FACILITY: ",DGDV,?20,DGDVN,?40,"TOTAL DISCHARGES: ",?50,^UTILITY("DGOD",$JOB,DGJB,DGTN,"TOT",DGDV)
- +3 IF $DATA(^UTILITY("DGOD",$JOB,DGJB,DGTN,DGDV,"HOSP"))>0
- WRITE ?65,"Patients remaining on "_T2_" : ",^UTILITY("DGOD",$JOB,DGJB,DGTN,DGDV,"HOSP"),!
- +4 WRITE !,?30,"AS",?40,"AN",?50,"B0",?60,"C0",?70,"N0",?80,"X0",?90,"U0",?100,"TOTAL",?110,"%",!
- +5 FOR I=30:10:110
- WRITE ?I,"------"
- +6 FOR DGV="V","N"
- WRITE !,?1,$SELECT(DGV="V":"VETERAN ELIGIBILITY",DGV="N":"NON-VETERAN ELIGIBILITY",1:0),!,?1,"-----------------------",!
- FOR DGEL=1:1:8,"*"
- DO PRI1
- +7 IF $DATA(Z(DGDV))=0
- SET Z(DGDV)=0
- IF ^UTILITY("DGOD",$JOB,DGJB,DGTN,"TOT",DGDV)>0
- DO TOTI^DGODTOT
- SET ^UTILITY("DGOD",$JOB,DGJB,DGTN,DGDV)=$CHAR(35)_U_DGGE_U_DGDV_U_DGJB_U_DGBD_U_DGND_U_Z(DGDV)_U_DGTOUT
- QUIT
- PRI1 ;print each row
- +1 IF ZRT[U
- QUIT
- 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
- +2 IF '((DGV="V")&(DGEL>6))
- WRITE !,?1,$PIECE(I5(DGV),U,DGEL)
- +3 IF DGEL="*"
- WRITE ?1,"ERROR"
- +4 IF '((DGV="V")&(DGEL>6))
- WRITE ?30,^UTILITY("DGOD",$JOB,DGJB,DGTN,DGDV,DGV,"AS",DGEL),?40,^UTILITY("DGOD",$JOB,DGJB,DGTN,DGDV,DGV,"AN",DGEL),?50,^UTILITY("DGOD",$JOB,DGJB,DGTN,DGDV,DGV,"B",DGEL),?60,^UTILITY("DGOD",$JOB,DGJB,DGTN,DGDV,DGV,"C",DGEL)
- +5 IF '((DGV="V")&(DGEL>6))
- WRITE ?70,^UTILITY("DGOD",$JOB,DGJB,DGTN,DGDV,DGV,"N",DGEL),?80,^UTILITY("DGOD",$JOB,DGJB,DGTN,DGDV,DGV,"X",DGEL),?90,^UTILITY("DGOD",$JOB,DGJB,DGTN,DGDV,DGV,"U",DGEL)
- +6 IF '((DGV="V")&(DGEL>6))
- WRITE ?100,^UTILITY("DGOD",$JOB,DGJB,DGTN,DGDV,DGV,"TOT",DGEL),?110,"("_$JUSTIFY(^UTILITY("DGOD",$JOB,DGJB,DGTN,DGDV,DGV,"TOT",DGEL)/^UTILITY("DGOD",$JOB,DGJB,DGTN,"TOT",DGDV)*100,2,2)_")",!
- +7 IF DGEL="*"
- DO TOT1
- +8 QUIT
- +9 ;
- TOT1 ;column subtotal
- +1 IF ZRT[U
- QUIT
- FOR I=30:10:110
- WRITE ?I,"------"
- +2 WRITE !,?1,"SUBTOTAL",?30,^UTILITY("DGOD",$JOB,DGJB,DGTN,DGDV,DGV,"TOT","AS"),?40,^("AN"),?50,^("B"),?60,^("C"),?70,^("N"),?80,^("X"),?90,^("U")
- +3 WRITE ?100,^UTILITY("DGOD",$JOB,DGJB,DGTN,DGDV,"TOT",DGV),?110,"("_$JUSTIFY(^UTILITY("DGOD",$JOB,DGJB,DGTN,DGDV,"TOT",DGV)/^UTILITY("DGOD",$JOB,DGJB,DGTN,"TOT",DGDV)*100,2,2)_")"
- +4 WRITE !,?1,"SUBTOTAL %",?30,$JUSTIFY(^UTILITY("DGOD",$JOB,DGJB,DGTN,DGDV,DGV,"TOT","AS")/^UTILITY("DGOD",$JOB,DGJB,DGTN,"TOT",DGDV)*100,2,2),?40,$JUSTIFY(^UTILITY("DGOD",...
- ... $JOB,DGJB,DGTN,DGDV,DGV,"TOT","AN")/^UTILITY("DGOD",$JOB,DGJB,DGTN,"TOT",DGDV)*100,2,2)
- +5 WRITE ?50,$JUSTIFY(^UTILITY("DGOD",$JOB,DGJB,DGTN,DGDV,DGV,"TOT","B")/^UTILITY("DGOD",$JOB,DGJB,DGTN,"TOT",DGDV)*100,2,2),?60,$JUSTIFY(^UTILITY("DGOD",$JOB,DGJB,DGTN,DGDV,DGV,"TOT","C")/^UTILITY("DGOD",$JOB,DGJB,DGTN,"TOT",DGDV)*100,2,2)
- +6 WRITE ?70,$JUSTIFY(^UTILITY("DGOD",$JOB,DGJB,DGTN,DGDV,DGV,"TOT","N")/^UTILITY("DGOD",$JOB,DGJB,DGTN,"TOT",DGDV)*100,2,2),?80,$JUSTIFY(^UTILITY("DGOD",$JOB,DGJB,DGTN,DGDV,DGV,"TOT","X")/^UTILITY("DGOD",$JOB,DGJB,DGTN,"TOT",DGDV)*100,2,2)
- +7 WRITE ?90,$JUSTIFY(^UTILITY("DGOD",$JOB,DGJB,DGTN,DGDV,DGV,"TOT","U")/^UTILITY("DGOD",$JOB,DGJB,DGTN,"TOT",DGDV)*100,2,2)
- +8 WRITE ?100,$JUSTIFY(^UTILITY("DGOD",$JOB,DGJB,DGTN,DGDV,"TOT",DGV)/^UTILITY("DGOD",$JOB,DGJB,DGTN,"TOT",DGDV)*100,2,2),!
- +9 QUIT
- +10 ;
