source: WorldVistAEHR/trunk/r/REGISTRATION-DGQE-DG-DPT-GRPX-VAD-VAF-VAS-VAT-VAU--VA-VIC--DGBT--DGJ--DGYA--VALM/DGODNSM.m@ 1520

Last change on this file since 1520 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 2.8 KB
RevLine 
[613]1DGODNSM ;ALB/EG - INPATIENT WORKLOAD SUMMARY ; 2/28/89 1600
2 ;;5.3;Registration;;Aug 13, 1993
3 ;;V 4.5
4 S A1X="AS^AN^B^C^N^X^U" I $P(A(1),U,1)'="" D REM Q
5 S HR="Inpatient Workload Summary",^UTILITY("DGOD",$J,"T","C")=0 W @IOF,!,?((IOM-$L(HR))/2),HR,?IOM-20,T2,!
6 W !,?1,"DATE RANGE: FROM " S Y=DGBD X ^DD("DD") W Y," TO " S Y=DGND X ^DD("DD") W Y,!
7 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
8 F J=1:1:7 S ^UTILITY("DGOD",$J,"T","C",J)=0
9 F K=1:1:DGTN F I=1:1:A2 S ^UTILITY("DGOD",$J,"T",K,I)=0
10 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))
11 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)
12 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)
13 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")
14 F K=1:1:DGTN W ! D HDR F I=1:1:A2 D PRI,TOT1^DGODOSM1:I=A2
15 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)
16 D TOT^DGODOSM1,REM W ! F I=1:1:4 W !,$P($T(LEG+I),";;",2)
17END K A,A1X,A2,DGBD,DGDV,DGMT,DGND,HDR1,HR,I,J,K,T2,X,Y,Z
18 Q
19PRI Q:^UTILITY("DGOD",$J,"T",K,I,"R")=0
20 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
21 W !,?1,$P(A(I),U,2),?7,$P(A(I),U,1)
22 W ?30,^UTILITY("DGOD",$J,"T",K,I,1),?40,^(2),?50,^(3),?60,^(4),?70,^(5),?80,^(6),?90,^(7)
23 W ?100,^UTILITY("DGOD",$J,"T",K,I,"R")
24 W ?110,"("_$J(^UTILITY("DGOD",$J,"T",K,I,"R")/^UTILITY("DGOD",$J,"T",K,"R")*100,2,2)_")",!
25 Q
26REM ;remaining patients
27 W !,?1,$P($T(HD+2),";;",2)," ON "_T2,!
28 S X="" F I=0:0 S X=$O(Z(X)) Q:X="" W !,?1,X,?20,Z(X)
29 W ! Q
30HDR S HDR1=$P($T(HD+K),";;",2) W !,?1,HDR1,!
31 W !,?1,"FACILITY",?30,"AS",?40,"AN",?50,"B0",?60,"C0",?70,"N0",?80,"X0",?90,"U0",?100,"TOTAL",?110,"%",!
32 Q
33LEG ;
34 ;;LEGEND: AS - Category A SC N0 - Nonveteran
35 ;; AN - Category A NSC X0 - Not Applicable
36 ;; B0 - Category B U0 - Require means test
37 ;; C0 - Category C
38HD ;;
39 ;;INPATIENT DISCHARGES
40 ;;PATIENTS REMAINING IN MEDICAL CENTER
Note: See TracBrowser for help on using the repository browser.