| 1 | NURSCPLC ;HIRMFO/RM,FT,MD-PATIENT CENSUS...WARD, AND HOSPITAL ;12/14/98
|
|---|
| 2 | ;;4.0;NURSING SERVICE;**20,22**;Apr 25, 1997
|
|---|
| 3 | EN2 ; ENTRY FOR WARD PATIENT CENSUS
|
|---|
| 4 | Q:'$D(^DIC(213.9,1,"OFF")) Q:$P(^DIC(213.9,1,"OFF"),"^",1)=1
|
|---|
| 5 | S (NURSZAP,NURPLSW,NURMDSW,NURQUIT,NURQUEUE)=0
|
|---|
| 6 | D EN9^NURSAGSP
|
|---|
| 7 | I NURMDSW S DIC(0)="AEMQZ",NURPLSCR=1 D EN5^NURSAGSP K NURPLSCR I $G(NUROUT) G QUIT
|
|---|
| 8 | I NURMDSW=0,NURPLSW=1 S NURPLCSR=1 D PRD^NURSAGSP K NURPLSCR I $G(NUROUT) G QUIT
|
|---|
| 9 | W ! D EN1^NURSAGSP G:$G(NUROUT) QUIT
|
|---|
| 10 | W ! D EN6^NURSUT0 I $G(NURQUIT) S NUROUT=1 G QUIT
|
|---|
| 11 | W ! S ZTDESC="Nursing Patient Census",ZTRTN="START^NURSCPLC" D EN7^NURSUT0 G:POP!($D(ZTSK)) QUIT
|
|---|
| 12 | START ;
|
|---|
| 13 | U IO S (NURSW1,NURPAGE,NUROUT)=0 K ^TMP($J)
|
|---|
| 14 | I NURHOSP S NURIEN=0 F S NURIEN=$O(^NURSF(214,"AF","A",NURIEN)) Q:NURIEN'>0 S DFN="" F S DFN=$O(^NURSF(214,"AF","A",NURIEN,DFN)) Q:DFN'>0 S NPWARD=NURIEN D EN6^NURSAUTL S NURSWARD=$E(NPWARD,1,20) W:$E(IOST)="C"&($R(100)) "." D SORT
|
|---|
| 15 | E S NURSWARD="" F S NURSWARD=$O(NURSNLOC(NURSWARD)) Q:NURSWARD="" S NURIEN=0 F S NURIEN=$O(NURSNLOC(NURSWARD,NURIEN)) Q:NURIEN'>0 S DFN=0 F S DFN=$O(^NURSF(214,"AF","A",NURIEN,DFN)) Q:DFN'>0 W:$E(IOST)="C"&($R(100)) "." D SORT
|
|---|
| 16 | I $E(IOST)="P" F NURI=1:1 Q:NURI>NCOPY D PRINT S (NURPAGE,NURSW1)=0 W:$G(NCOPY)>1 @IOF
|
|---|
| 17 | I $E(IOST)="C" D PRINT
|
|---|
| 18 | QUIT ; KILL LOCAL VARIABLES
|
|---|
| 19 | D CLOSE^NURSUT1,^NURSKILL
|
|---|
| 20 | Q
|
|---|
| 21 | SORT ; SORT OF PATIENT CENSUS
|
|---|
| 22 | S NURFAC(2)=$S($$EN12^NURSUT3(NURIEN)'="":$$EN12^NURSUT3(NURIEN),1:" BLANK")
|
|---|
| 23 | S NURPROG(4)=+$P(^NURSF(211.4,+NURIEN,1),U,4),NURPROG(4)=$$GET1^DIQ(212.7,+NURPROG(4),.01,"I") S:NURPROG(4)="" NURPROG(4)=" BLANK"
|
|---|
| 24 | I NURMDSW,$G(NURFAC)=0,NURFAC(2)'=NURFAC(1) Q
|
|---|
| 25 | I NURPLSW,$G(NURPROG)=0,NURPROG(4)'=NURPROG(1) Q
|
|---|
| 26 | D 1^VADPT
|
|---|
| 27 | S NBED=$S(VAIN(5)="":" BLANK",1:VAIN(5)),N1=$S(VADM(1)="":" BLANK",1:VADM(1))
|
|---|
| 28 | S:$G(NURSORT)="" NURSORT=1
|
|---|
| 29 | N X S X=$G(^TMP($J,"L",NURFAC(2),NURPROG(4),NURSWARD))
|
|---|
| 30 | I X="" S X=NURSORT,NURSORT=NURSORT+1,^TMP($J,"L",NURFAC(2),NURPROG(4),NURSWARD)=X,^TMP($J,"NURLOC",NURSWARD)=""
|
|---|
| 31 | S ^TMP($J,"L1",X,NBED,N1,DFN)=""
|
|---|
| 32 | K VAIN,VADM Q
|
|---|
| 33 | HEADER ; PRINTING OF HEADING ROUTINE
|
|---|
| 34 | I 'NURQUEUE,NURSW1,$E(IOST)="C" D ENDPG^NURSUT1 Q:NUROUT
|
|---|
| 35 | S NURSHD="PATIENT CENSUS"_$S($D(^TMP($J,"NURLOC",NL1)):" FOR "_$E(NL1,1,12),1:"")
|
|---|
| 36 | S NURSW1=1
|
|---|
| 37 | S NURPAGE=NURPAGE+1 W:$E(IOST)="C"!(NURPAGE>1) @IOF
|
|---|
| 38 | I NURMDSW,$G(NURHOSP) W !,?$$CNTR^NURSUT2($G(NURFAC(2))),$S($G(NURFAC(2))=" BLANK":"NO FACILITY",1:$G(NURFAC(2)))
|
|---|
| 39 | W !,$E(DT,4,5),"/",$E(DT,6,7),"/",$E(DT,2,3),?28,NURSHD,?68,"PAGE: ",NURPAGE,!
|
|---|
| 40 | W !,"ROOM/BED",?17,"PATIENT NAME",?42,"SSN",?55,"ABSENCE",?64,"BED SEC",?73,"ACUITY"
|
|---|
| 41 | W !,$$REPEAT^XLFSTR("-",80),!
|
|---|
| 42 | PROD I NURPLSW,$G(NURPROG(4))'=" BLANK" W !?$$CNTR^NURSUT2(NURPROG(4)),$S($E(NURPROG(4),1)=" ":$E(NURPROG(4),2,99),1:$G(NURPROG(4))) W !,?$$CNTR^NURSUT2(NURPROG(4)),$$REPEAT^XLFSTR("-",$L(NURPROG(4))+1),!
|
|---|
| 43 | Q
|
|---|
| 44 | PRINT ;PRINT ROUTINE
|
|---|
| 45 | I $O(^TMP($J,""))="",'$D(NURSNLOC) S NL1="THE HOSPITAL",NURPROG(4)=$S($G(NURPROG)=0:NURPROG(1),1:" BLANK"),NURFAC(2)=$S($G(NURFAC)=0:NURFAC(1),1:" BLANK") D HEADER W $C(7),!,"THERE IS NO DATA FOR THIS REPORT" Q
|
|---|
| 46 | I $O(^TMP($J,""))="",$D(NURSNLOC) S NURPROG(4)=$S($G(NURPROG)=0:NURPROG(1),1:" BLANK") S NL1="" F S NL1=$O(NURSNLOC(NL1)) Q:NL1="" D:NURSW1=0 HEADER S NURSW1=1 D NODATA^NURSUT1
|
|---|
| 47 | I $O(^TMP($J,""))'="",$D(NURSNLOC) D I NURSW1=1 D ENDPG^NURSUT1 S NURSW1=0
|
|---|
| 48 | . S (NURX,NURY,NURZ)="" F S NURY=$O(^TMP($J,"L",NURY)) Q:NURY="" F S NURZ=$O(^TMP($J,"L",NURY,NURZ)) Q:NURZ="" F S NURX=$O(^TMP($J,"L",NURY,NURZ,NURX)) Q:NURX=""
|
|---|
| 49 | . S NL1="" F S NL1=$O(NURSNLOC(NL1)) Q:NL1="" I '$D(^TMP($J,"NURLOC",NL1)) D
|
|---|
| 50 | . . S NURPROG(4)=$S($G(NURPROG)=0:NURPROG(1),1:" BLANK"),NURFAC(2)=$S($G(NURFAC)=0:NURFAC(1),1:"") D:NURSW1=0 HEADER S NURSW1=1 D NODATA^NURSUT1
|
|---|
| 51 | . . Q
|
|---|
| 52 | . Q
|
|---|
| 53 | S NURFAC(2)="" F S NURFAC(2)=$O(^TMP($J,"L",NURFAC(2))) Q:NURFAC(2)="" D NM Q:$G(NUROUT) S NURSW1=0
|
|---|
| 54 | Q
|
|---|
| 55 | NM S NURPROG(4)="" F S NURPROG(4)=$O(^TMP($J,"L",NURFAC(2),NURPROG(4))) Q:NURPROG(4)="" D NN Q:$G(NUROUT) W !!
|
|---|
| 56 | Q
|
|---|
| 57 | NN S NL1="" F S NL1=$O(^TMP($J,"L",NURFAC(2),NURPROG(4),NL1)) Q:NL1="" S NURSORT=$G(^TMP($J,"L",NURFAC(2),NURPROG(4),NL1)) I NURSORT D HEADER Q:NUROUT D NO Q:$G(NUROUT)
|
|---|
| 58 | Q
|
|---|
| 59 | NO S NBED="" F S NBED=$O(^TMP($J,"L1",NURSORT,NBED)) Q:NBED="" D NP Q:NUROUT
|
|---|
| 60 | Q
|
|---|
| 61 | NP S N1="" F S N1=$O(^TMP($J,"L1",NURSORT,NBED,N1)) Q:N1="" D NQ Q:NUROUT
|
|---|
| 62 | Q
|
|---|
| 63 | NQ S DFN=0 F S DFN=$O(^TMP($J,"L1",NURSORT,NBED,N1,DFN)) Q:DFN'>0 D PRINT1 Q:NUROUT
|
|---|
| 64 | Q
|
|---|
| 65 | PRINT1 D DEM^VADPT S SSN=VA("PID") D ^NURSAPCH
|
|---|
| 66 | S NSEC=$S('$D(^NURSF(214,DFN,0)):"",$P(^(0),"^",4)="":"",'$D(^NURSF(213.3,$P(^NURSF(214,DFN,0),"^",4),0)):"",1:$P(^NURSF(213.3,$P(^NURSF(214,DFN,0),"^",4),1),"^",1)) D FNDCLAS
|
|---|
| 67 | D:$Y>(IOSL-6)!('NURSW1) HEADER Q:NUROUT W !,$S(NBED'=" BLANK":NBED,1:""),?17,$S(N1'=" BLANK":$E(N1,1,19),1:""),?38,SSN,?56,$S($D(NURSX):NURSX,1:""),?66,NSEC,?75,NURCAT
|
|---|
| 68 | Q
|
|---|
| 69 | FNDCLAS D EN6^NURSCUTL S NURSCLAS("CL")=1 D EN2^NURSCUTL S NURCAT=$S(NURSCLAS'="":$P(^NURSA(214.6,NURSCLAS,0),"^",3),1:"")
|
|---|
| 70 | Q
|
|---|
