| [613] | 1 | DGPMTSO1 ;ALB/LM - TREATING SPECIALTY INPATIENT LISTING BY WARDS ;2-2-93
|
|---|
| 2 | ;;5.3;Registration;;Aug 13, 1993
|
|---|
| 3 | ;
|
|---|
| 4 | START Q:'PTLWD
|
|---|
| 5 | S REPORT="< < PATIENT LISTING BY WARD > >"
|
|---|
| 6 | S (PAGE,TOTAL)=0
|
|---|
| 7 | D HEAD^DGPMTSO
|
|---|
| 8 | D SUBHEAD
|
|---|
| 9 | ;
|
|---|
| 10 | DIV S DIV="" F DIV1=0:0 S DIV=$O(^TMP($J,"PTLWD",DIV)) Q:DIV="" D:$Y+8>IOSL HEAD^DGPMTSO,SUBHEAD Q:END W !?5,"DIVISION: ",$S($D(^DG(40.8,DIV,0)):$P(^(0),"^"),1:"EMPTY") D WARD Q:END S SUBCOUNT=^TMP($J,"PTLWD",DIV) D TOTAL Q:END
|
|---|
| 11 | ;
|
|---|
| 12 | G:END END
|
|---|
| 13 | D:$Y+8>IOSL HEAD^DGPMTSO,SUBHEAD Q:END
|
|---|
| 14 | F L=1:1:(IOM-3) W "-"
|
|---|
| 15 | W !!?3,"TOTAL = ",$J($P(TOTAL,"^",1),4),?25,"PASS = ",$J($P(TOTAL,"^",2),4),?45,"AA = ",$J($P(TOTAL,"^",3),4),?65,"UA = ",$J($P(TOTAL,"^",4),4),?85,"ASIH = ",$J($P(TOTAL,"^",5),4),?105,"PTS REMAINING = ",$J($P(TOTAL,"^",6),4)
|
|---|
| 16 | S PTLWD=0
|
|---|
| 17 | ;
|
|---|
| 18 | END K ABSENCE,ADMDT,DGW,DGW1,DIV,DIV1,ID,IFN,L,PAGE,PTNM,PTNM1,REPORT,SUBCOUNT,TOTAL,TREAT,TSXFR,WARD,WARD1,PTLWD,SUBNAME
|
|---|
| 19 | Q
|
|---|
| 20 | ;
|
|---|
| 21 | WARD S WARD="" F WARD1=0:0 S WARD=$O(^TMP($J,"PTLWD",DIV,WARD)) Q:WARD="" Q:END D DGW
|
|---|
| 22 | Q
|
|---|
| 23 | ;
|
|---|
| 24 | DGW S DGW="" F DGW1=0:0 S DGW=$O(^TMP($J,"PTLWD",DIV,WARD,DGW)) Q:DGW="" D:$Y+8>IOSL HEAD^DGPMTSO,SUBHEAD Q:END W !!?10,"INPATIENT WARD: ",WARD D PTNM Q:END S SUBCOUNT=^TMP($J,"PTLWD",DIV,WARD,DGW) S SUBNAME="WARD" D SUB Q:END
|
|---|
| 25 | Q
|
|---|
| 26 | ;
|
|---|
| 27 | PTNM S PTNM="" F PTNM1=0:0 S PTNM=$O(^TMP($J,"PTLWD",DIV,WARD,DGW,PTNM)) Q:PTNM="" F IFN=0:0 S IFN=$O(^TMP($J,"PTLWD",DIV,WARD,DGW,PTNM,IFN)) Q:'IFN D INFO Q:END
|
|---|
| 28 | Q
|
|---|
| 29 | ;
|
|---|
| 30 | INFO S TREAT=$P(^TMP($J,"PTLWD",DIV,WARD,DGW,PTNM,IFN),"^")
|
|---|
| 31 | S ADMDT=$P(^TMP($J,"PTLWD",DIV,WARD,DGW,PTNM,IFN),"^",2)
|
|---|
| 32 | S TSXFR=$P(^TMP($J,"PTLWD",DIV,WARD,DGW,PTNM,IFN),"^",3)
|
|---|
| 33 | S ABSENCE=$P(^TMP($J,"PTLWD",DIV,WARD,DGW,PTNM,IFN),"^",4)
|
|---|
| 34 | S ID=$S($D(^DPT(IFN,.36)):$P(^DPT(IFN,.36),"^",3),1:"")
|
|---|
| 35 | ;
|
|---|
| 36 | I $Y+8>IOSL D HEAD^DGPMTSO,SUBHEAD Q:END
|
|---|
| 37 | LINE W !,PTNM,?30,ID,?45,ADMDT,?65,TREAT,?100,TSXFR,?120,ABSENCE
|
|---|
| 38 | Q
|
|---|
| 39 | ;
|
|---|
| 40 | ;
|
|---|
| 41 | TOTAL S $P(TOTAL,"^",1)=$P(TOTAL,"^",1)+$P(SUBCOUNT,"^",1) ; current patients
|
|---|
| 42 | S $P(TOTAL,"^",2)=$P(TOTAL,"^",2)+$P(SUBCOUNT,"^",2) ; pass
|
|---|
| 43 | S $P(TOTAL,"^",3)=$P(TOTAL,"^",3)+$P(SUBCOUNT,"^",3) ; aa
|
|---|
| 44 | S $P(TOTAL,"^",4)=$P(TOTAL,"^",4)+$P(SUBCOUNT,"^",4) ; ua
|
|---|
| 45 | S $P(TOTAL,"^",5)=$P(TOTAL,"^",5)+$P(SUBCOUNT,"^",5) ; asih
|
|---|
| 46 | S $P(TOTAL,"^",6)=$P(TOTAL,"^")-$P(TOTAL,"^",3)-$P(TOTAL,"^",4)-$P(TOTAL,"^",5) ; Current patient minus absences except Pass equals patient's remaining.
|
|---|
| 47 | ;
|
|---|
| 48 | S SUBNAME="DIVISION"
|
|---|
| 49 | ;
|
|---|
| 50 | SUB D:$Y+6>IOSL HEAD^DGPMTSO Q:END
|
|---|
| 51 | ;
|
|---|
| 52 | S $P(SUBCOUNT,"^",6)=$P(SUBCOUNT,"^")-$P(SUBCOUNT,"^",3)-$P(SUBCOUNT,"^",4)-$P(SUBCOUNT,"^",5) ; Current patient minus absences except Pass equals patient's remaining.
|
|---|
| 53 | W !
|
|---|
| 54 | F L=1:1:(IOM-3) W "-"
|
|---|
| 55 | W !,SUBNAME,!
|
|---|
| 56 | W "SUBCOUNT = ",$J($P(SUBCOUNT,"^",1),4),?25,"PASS = ",$J($P(SUBCOUNT,"^",2),4),?45,"AA = ",$J($P(SUBCOUNT,"^",3),4),?65,"UA = ",$J($P(SUBCOUNT,"^",4),4),?85,"ASIH = ",$J($P(SUBCOUNT,"^",5),4)
|
|---|
| 57 | W ?105,"PTS REMAINING = ",$J($P(SUBCOUNT,"^",6),4),!
|
|---|
| 58 | Q
|
|---|
| 59 | ;
|
|---|
| 60 | SUBHEAD ;
|
|---|
| 61 | Q:END
|
|---|
| 62 | W !!,"PATIENT",?30,"PT'S ID",?45,"ADMISSION DATE",?65,"LAST FACILITY TREATING SPECIALTY",?100,"LAST TS SERVICE",?120,"ABSENCE",!
|
|---|
| 63 | F L=1:1:(IOM-3) W "-"
|
|---|
| 64 | W !
|
|---|
| 65 | Q
|
|---|
