- DGODNSM ;ALB/EG - INPATIENT WORKLOAD SUMMARY ; 2/28/89 1600
- ;;5.3;Registration;**1015**;Aug 13, 1993;Build 21
- ;;V 4.5
- S A1X="AS^AN^B^C^N^X^U" I $P(A(1),U,1)'="" D REM Q
- S HR="Inpatient Workload Summary",^UTILITY("DGOD",$J,"T","C")=0 W @IOF,!,?((IOM-$L(HR))/2),HR,?IOM-20,T2,!
- W !,?1,"DATE RANGE: FROM " S Y=DGBD X ^DD("DD") W Y," TO " S Y=DGND X ^DD("DD") W Y,!
- F K=1:1:DGTN S ^UTILITY("DGOD",$J,"T",K,"R")=0 F I=1:1:A2 S ^UTILITY("DGOD",$J,"T",K,I,"R")=0 F J=1:1:7 S (^UTILITY("DGOD",$J,"T1",K,I,J),^UTILITY("DGOD",$J,"T",K,I,J))=0,^UTILITY("DGOD",$J,"T",K,"C",J)=0
- F J=1:1:7 S ^UTILITY("DGOD",$J,"T","C",J)=0
- F K=1:1:DGTN F I=1:1:A2 S ^UTILITY("DGOD",$J,"T",K,I)=0
- F K=1:1:DGTN F I=1:1:A2 F DGMT=1:1:7 S DGDV=$P(A(I),U,2) I ^UTILITY("DGOD",$J,DGJB,K,"TOT",DGDV)>0 S ^UTILITY("DGOD",$J,"T1",K,I,DGMT)=^UTILITY("DGOD",$J,"T1",K,I,DGMT)+^UTILITY("DGOD",$J,DGJB,K,"TOT",DGDV,$P(A1X,U,DGMT))
- F K=1:1:DGTN F I=1:1:A2 F DGMT=1:1:7 S DGDV=$P(A(I),U,2) I ^UTILITY("DGOD",$J,DGJB,K,"TOT",DGDV)>0 S ^UTILITY("DGOD",$J,"T",K,I,DGMT)=^UTILITY("DGOD",$J,"T",K,I,DGMT)+^UTILITY("DGOD",$J,"T1",K,I,DGMT)
- F K=1:1:DGTN F I=1:1:A2 F DGMT=1:1:7 S ^UTILITY("DGOD",$J,"T",K,I,"R")=^UTILITY("DGOD",$J,"T",K,I,"R")+^UTILITY("DGOD",$J,"T",K,I,DGMT),^UTILITY("DGOD",$J,"T",K,"C",DGMT)=^UTILITY("DGOD",$J,"T",K,"C",DGMT)+^UTILITY("DGOD",$J,"T",K,I,DGMT)
- F K=1:1:DGTN F I=1:1:A2 S ^UTILITY("DGOD",$J,"T",K,"R")=^UTILITY("DGOD",$J,"T",K,"R")+^UTILITY("DGOD",$J,"T",K,I,"R")
- F K=1:1:DGTN W ! D HDR F I=1:1:A2 D PRI,TOT1^DGODOSM1:I=A2
- F K=1:1:DGTN S ^UTILITY("DGOD",$J,"T","C")=^UTILITY("DGOD",$J,"T","C")+^UTILITY("DGOD",$J,"T",K,"R") F J=1:1:7 S ^UTILITY("DGOD",$J,"T","C",J)=^UTILITY("DGOD",$J,"T","C",J)+^UTILITY("DGOD",$J,"T",K,"C",J)
- D TOT^DGODOSM1,REM W ! F I=1:1:4 W !,$P($T(LEG+I),";;",2)
- END K A,A1X,A2,DGBD,DGDV,DGMT,DGND,HDR1,HR,I,J,K,T2,X,Y,Z
- Q
- PRI Q:^UTILITY("DGOD",$J,"T",K,I,"R")=0
- 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 !,?1,$P(A(I),U,2),?7,$P(A(I),U,1)
- W ?30,^UTILITY("DGOD",$J,"T",K,I,1),?40,^(2),?50,^(3),?60,^(4),?70,^(5),?80,^(6),?90,^(7)
- W ?100,^UTILITY("DGOD",$J,"T",K,I,"R")
- W ?110,"("_$J(^UTILITY("DGOD",$J,"T",K,I,"R")/^UTILITY("DGOD",$J,"T",K,"R")*100,2,2)_")",!
- Q
- REM ;remaining patients
- W !,?1,$P($T(HD+2),";;",2)," ON "_T2,!
- S X="" F I=0:0 S X=$O(Z(X)) Q:X="" W !,?1,X,?20,Z(X)
- W ! Q
- HDR S HDR1=$P($T(HD+K),";;",2) W !,?1,HDR1,!
- W !,?1,"FACILITY",?30,"AS",?40,"AN",?50,"B0",?60,"C0",?70,"N0",?80,"X0",?90,"U0",?100,"TOTAL",?110,"%",!
- Q
- LEG ;
- ;;LEGEND: AS - Category A SC N0 - Nonveteran
- ;; AN - Category A NSC X0 - Not Applicable
- ;; B0 - Category B U0 - Require means test
- ;; C0 - Category C
- HD ;;
- ;;INPATIENT DISCHARGES
- ;;PATIENTS REMAINING IN MEDICAL CENTER
- DGODNSM ;ALB/EG - INPATIENT WORKLOAD SUMMARY ; 2/28/89 1600
- +1 ;;5.3;Registration;**1015**;Aug 13, 1993;Build 21
- +2 ;;V 4.5
- +3 SET A1X="AS^AN^B^C^N^X^U"
- IF $PIECE(A(1),U,1)'=""
- DO REM
- QUIT
- +4 SET HR="Inpatient Workload Summary"
- SET ^UTILITY("DGOD",$JOB,"T","C")=0
- WRITE @IOF,!,?((IOM-$LENGTH(HR))/2),HR,?IOM-20,T2,!
- +5 WRITE !,?1,"DATE RANGE: FROM "
- SET Y=DGBD
- XECUTE ^DD("DD")
- WRITE Y," TO "
- SET Y=DGND
- XECUTE ^DD("DD")
- WRITE Y,!
- +6 FOR K=1:1:DGTN
- SET ^UTILITY("DGOD",$JOB,"T",K,"R")=0
- FOR I=1:1:A2
- SET ^UTILITY("DGOD",$JOB,"T",K,I,"R")=0
- FOR J=1:1:7
- SET (^UTILITY("DGOD",$JOB,"T1",K,I,J),^UTILITY("DGOD",$JOB,"T",K,I,J))=0
- SET ^UTILITY("DGOD",$JOB,"T",K,"C",J)=0
- +7 FOR J=1:1:7
- SET ^UTILITY("DGOD",$JOB,"T","C",J)=0
- +8 FOR K=1:1:DGTN
- FOR I=1:1:A2
- SET ^UTILITY("DGOD",$JOB,"T",K,I)=0
- +9 FOR K=1:1:DGTN
- FOR I=1:1:A2
- FOR DGMT=1:1:7
- SET DGDV=$PIECE(A(I),U,2)
- IF ^UTILITY("DGOD",$JOB,DGJB,K,"TOT",DGDV)>0
- SET ^UTILITY("DGOD",$JOB,"T1",K,I,DGMT)=^UTILITY("DGOD",$JOB,"T1",K,I,DGMT)+^UTILITY("DGOD",$JOB,DGJB,K,"TOT",DGDV,$PIECE(A1X,U,DGMT))
- +10 FOR K=1:1:DGTN
- FOR I=1:1:A2
- FOR DGMT=1:1:7
- SET DGDV=$PIECE(A(I),U,2)
- IF ^UTILITY("DGOD",$JOB,DGJB,K,"TOT",DGDV)>0
- SET ^UTILITY("DGOD",$JOB,"T",K,I,DGMT)=^UTILITY("DGOD",$JOB,"T",K,I,DGMT)+^UTILITY("DGOD",$JOB,"T1",K,I,DGMT)
- +11 FOR K=1:1:DGTN
- FOR I=1:1:A2
- FOR DGMT=1:1:7
- SET ^UTILITY("DGOD",$JOB,"T",K,I,"R")=^UTILITY("DGOD",$JOB,"T",K,I,"R")+^UTILITY("DGOD",$JOB,"T",K,I,DGMT)
- SET ^UTILITY("DGOD",$JOB,"T",K,"C",DGMT)=^UTILITY("DGOD",$JOB,"T",K,"C",DGMT)+^UTILITY("DGOD",$JOB,"T",K,I,DGMT)
- +12 FOR K=1:1:DGTN
- FOR I=1:1:A2
- SET ^UTILITY("DGOD",$JOB,"T",K,"R")=^UTILITY("DGOD",$JOB,"T",K,"R")+^UTILITY("DGOD",$JOB,"T",K,I,"R")
- +13 FOR K=1:1:DGTN
- WRITE !
- DO HDR
- FOR I=1:1:A2
- DO PRI
- IF I=A2
- DO TOT1^DGODOSM1
- +14 FOR K=1:1:DGTN
- SET ^UTILITY("DGOD",$JOB,"T","C")=^UTILITY("DGOD",$JOB,"T","C")+^UTILITY("DGOD",$JOB,"T",K,"R")
- FOR J=1:1:7
- SET ^UTILITY("DGOD",$JOB,"T","C",J)=^UTILITY("DGOD",$JOB,"T","C",J)+^UTILITY("DGOD",$JOB,"T",K,"C",J)
- +15 DO TOT^DGODOSM1
- DO REM
- WRITE !
- FOR I=1:1:4
- WRITE !,$PIECE($TEXT(LEG+I),";;",2)
- END KILL A,A1X,A2,DGBD,DGDV,DGMT,DGND,HDR1,HR,I,J,K,T2,X,Y,Z
- +1 QUIT
- PRI IF ^UTILITY("DGOD",$JOB,"T",K,I,"R")=0
- QUIT
- +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
- +2 WRITE !,?1,$PIECE(A(I),U,2),?7,$PIECE(A(I),U,1)
- +3 WRITE ?30,^UTILITY("DGOD",$JOB,"T",K,I,1),?40,^(2),?50,^(3),?60,^(4),?70,^(5),?80,^(6),?90,^(7)
- +4 WRITE ?100,^UTILITY("DGOD",$JOB,"T",K,I,"R")
- +5 WRITE ?110,"("_$JUSTIFY(^UTILITY("DGOD",$JOB,"T",K,I,"R")/^UTILITY("DGOD",$JOB,"T",K,"R")*100,2,2)_")",!
- +6 QUIT
- REM ;remaining patients
- +1 WRITE !,?1,$PIECE($TEXT(HD+2),";;",2)," ON "_T2,!
- +2 SET X=""
- FOR I=0:0
- SET X=$ORDER(Z(X))
- IF X=""
- QUIT
- WRITE !,?1,X,?20,Z(X)
- +3 WRITE !
- QUIT
- HDR SET HDR1=$PIECE($TEXT(HD+K),";;",2)
- WRITE !,?1,HDR1,!
- +1 WRITE !,?1,"FACILITY",?30,"AS",?40,"AN",?50,"B0",?60,"C0",?70,"N0",?80,"X0",?90,"U0",?100,"TOTAL",?110,"%",!
- +2 QUIT
- LEG ;
- +1 ;;LEGEND: AS - Category A SC N0 - Nonveteran
- +2 ;; AN - Category A NSC X0 - Not Applicable
- +3 ;; B0 - Category B U0 - Require means test
- +4 ;; C0 - Category C
- HD ;;
- +1 ;;INPATIENT DISCHARGES
- +2 ;;PATIENTS REMAINING IN MEDICAL CENTER
