| 1 | NURARCRW ;HIRMFO/RM/FT/MD-VIEW PRINT PATIENT CLASSIFICATIONS BY WARD ;12/8/98
 | 
|---|
| 2 |  ;;4.0;NURSING SERVICE;**12,20,22,26**;Apr 25, 1997
 | 
|---|
| 3 |  Q:'$D(^DIC(213.9,1,"OFF"))  Q:$P(^DIC(213.9,1,"OFF"),"^",1)=1
 | 
|---|
| 4 |  S (NURQUIT,NURHOSP,NDATA,NURPAGE,NUROUT,NURQUEUE,NBRK,NURMDSW,NSW1,NURSW1)=0
 | 
|---|
| 5 |  D EN9^NURSAGSP
 | 
|---|
| 6 | REENT ;
 | 
|---|
| 7 |  W !!,?30,$S($G(NURCURSW):"Current",1:"Unit")_" Classification"
 | 
|---|
| 8 |  W !!,?17,"Press return if total hospital report is desired"
 | 
|---|
| 9 |  W !!,?17,"Enter unit number if this is a unit report: " R X:DTIME
 | 
|---|
| 10 |  I (X="^")!('$T) S NUROUT=1 G QUIT
 | 
|---|
| 11 |  I X="" S (NCOPY,NURHOSP)=1 G DEV
 | 
|---|
| 12 |  S DIC("S")="I $S('$P($G(^NURSF(211.4,+Y,""I"")),U)'=""I"":1,1:0),$S($P($G(^(1)),U)=""A"":1,1:0)"
 | 
|---|
| 13 |  S DIC="^NURSF(211.4,",DIC(0)="EQMZ" D ^DIC K DIC
 | 
|---|
| 14 |  G:+Y'>0 REENT
 | 
|---|
| 15 |  W ! D EN6^NURSUT0 G:NURQUIT QUIT
 | 
|---|
| 16 |  S NURSW1=+Y,NURSW1("F")=Y(0,0)
 | 
|---|
| 17 | DEV I NURMDSW,NURHOSP W ! S DIC(0)="AEMQZ" D EN8^NURSAGSP I $G(NUROUT) G QUIT
 | 
|---|
| 18 |  W ! S ZTRTN="START^NURARCRW" D EN7^NURSUT0 G:POP!($D(ZTSK)) QUIT
 | 
|---|
| 19 | START ;
 | 
|---|
| 20 |  K ^TMP($J) S NTC=0 F X=1:1:5 S NTC(X)=0
 | 
|---|
| 21 |  U IO I 'NURHOSP D SORT G QUIT:NUROUT
 | 
|---|
| 22 |  I NURHOSP D
 | 
|---|
| 23 |  .  F NURSW1=0:0 S NURSW1=$O(^NURSF(214,"AF","A",NURSW1)) Q:NURSW1'>0  D SORT Q:NUROUT
 | 
|---|
| 24 |  .  Q
 | 
|---|
| 25 |  I $E(IOST)="P" F NURI=1:1 Q:NURI>NCOPY  D PRINT S (NSW1,NURPAGE)=0 W:$G(NCOPY)>1 @IOF
 | 
|---|
| 26 |  I $E(IOST)="C" D PRINT
 | 
|---|
| 27 | QUIT D:'NUROUT CLOSE^NURSUT1,^NURAKILL
 | 
|---|
| 28 |  Q
 | 
|---|
| 29 | PRINT ;
 | 
|---|
| 30 |  S X=$O(^TMP($J,"")) I X="" S NDATA=1 S NURSWARD=$G(NURSW1("F")),NURFAC(3)=$S($G(NURFAC)=0:$G(NURFAC(1)),1:"") D HEADER W !!,"THERE IS NO DATA FOR "_$S($G(NURSW1("F"))'="":"THIS UNIT",1:"THE HOSPITAL") Q
 | 
|---|
| 31 |  S NURFAC(3)="" F  S NURFAC(3)=$O(^TMP($J,NURFAC(3))) Q:NURFAC(3)=""  D NN Q:NUROUT
 | 
|---|
| 32 |  Q
 | 
|---|
| 33 | NN S NURSWARD="" F  S NURSWARD=$O(^TMP($J,NURFAC(3),NURSWARD)) Q:NURSWARD=""  D:NSW1 HEADER Q:NUROUT  D NO Q:NUROUT
 | 
|---|
| 34 |  Q
 | 
|---|
| 35 | NO S NBEDS="" F  S NBEDS=$O(^TMP($J,NURFAC(3),NURSWARD,NBEDS)) Q:NBEDS=""  D:NSW1 BRK D NP Q:NUROUT  W !
 | 
|---|
| 36 |  Q
 | 
|---|
| 37 | NP S N1="" F  S N1=$O(^TMP($J,NURFAC(3),NURSWARD,NBEDS,N1)) Q:N1=""  D NQ Q:NUROUT
 | 
|---|
| 38 |  Q
 | 
|---|
| 39 | NQ S NSUB="" F  S NSUB=$O(^TMP($J,NURFAC(3),NURSWARD,NBEDS,N1,NSUB)) Q:NSUB=""  D PRINTIT Q:NUROUT
 | 
|---|
| 40 |  Q
 | 
|---|
| 41 | BRK W !,?8,"NURSING BED SECTION:  ",NBEDS S NBD=(NBEDS="HEMODIALYSIS"!(NBEDS="DOMICILIARY")!(NBEDS="RECOVERY ROOM"))
 | 
|---|
| 42 |  Q
 | 
|---|
| 43 | PRINTIT I 'NSW1!($Y>(IOSL-6)) D HEADER Q:NUROUT  W:NURSW1 ! D BRK Q:NUROUT
 | 
|---|
| 44 |  S DFN=$P(NSUB,"--",1),DA=$P(NSUB,"--",2) D DEM^VADPT
 | 
|---|
| 45 |  S DATA=$S(DA'="":^NURSA(214.6,DA,0),1:""),SSN=VA("PID")
 | 
|---|
| 46 |  W !!
 | 
|---|
| 47 |  W:N1'="  BLANK" ?2,$E(N1,1,20)
 | 
|---|
| 48 |  I NBD W ?24,"CLASSIFICATION NOT APPLICABLE"
 | 
|---|
| 49 |  I 'NBD W ?24,$P(DATA,"^",3)
 | 
|---|
| 50 |  I 'NBD F X=1:1:$L($P(DATA,"^",4)) W ?(31+((X-1)*2)),$E($P(DATA,"^",4),X)
 | 
|---|
| 51 |  I 'NBD S Y=$P(DATA,"^",1) D:+Y D^DIQ W ?42,$P(Y,":",1,2),?62,$E($P(DATA,"^",7),1,18)
 | 
|---|
| 52 |  W !,?2,SSN I $L($P(DATA,"^",7))>18,'NBD W ?62,$E($P(DATA,"^",7),19,36) I $L($P(DATA,"^",7))>36 W !,?62,$E($P(DATA,"^",7),37,50)
 | 
|---|
| 53 |  Q
 | 
|---|
| 54 | HEADER ;HEAD ROUTINE
 | 
|---|
| 55 |  I '$G(NDATA),'NURQUEUE,NSW1,$E(IOST)="C" D ENDPG^NURSUT1 Q:NUROUT
 | 
|---|
| 56 |  S NURPAGE=NURPAGE+1
 | 
|---|
| 57 |  W !,@IOF,?2,"UNIT PATIENT CLASSIFICATION REPORT",?51,"DATE:" S Y=DT D:+Y D^DIQ W ?57,Y,?71,"PAGE: ",NURPAGE
 | 
|---|
| 58 |  W !!,?2,"PATIENT NAME/SSN",?24,"CLASS.",?32,"FACTORS",?43,"DATE",?62,"COMMENTS",!,$$REPEAT^XLFSTR("-",80)
 | 
|---|
| 59 |  I NURHOSP,NURMDSW W !,?$$CNTR^NURSUT2(NURFAC(3)),$S($G(NURFAC(3))=" BLANK":"NO FACILITY",1:$G(NURFAC(3)))
 | 
|---|
| 60 |  I $G(NURCURSW),$O(^TMP($J,""))'="",'NSW1,$D(NTC) D CAT
 | 
|---|
| 61 |  W:NURSWARD'="" !!,?5,"UNIT:   ",NURSWARD
 | 
|---|
| 62 |  S NSW1=1
 | 
|---|
| 63 |  Q
 | 
|---|
| 64 | SORT ;
 | 
|---|
| 65 |  S:'NURHOSP!'(NURMDSW) NURFAC(2)=" BLANK"
 | 
|---|
| 66 |  I NURMDSW,$G(NURFAC(2))'=" BLANK" S NURFAC(2)=$$EN12^NURSUT3($G(NURSW1))
 | 
|---|
| 67 |  I NURMDSW,NURHOSP,$G(NURFAC)=0,$G(NURFAC(1))'=$G(NURFAC(2)) Q
 | 
|---|
| 68 |  F DFN=0:0 S DFN=$O(^NURSF(214,"AF","A",NURSW1,DFN)) Q:DFN'>0  D
 | 
|---|
| 69 |  .  D EN6^NURSCUTL S NURSCLAS("CL")=1 D EN2^NURSCUTL,DEM^VADPT
 | 
|---|
| 70 |  .  I $S(NURSCLAS="":0,$D(^NURSA(214.6,"E",NURSW1,NURSCLAS)):0,1:1) S NURSCLAS=""
 | 
|---|
| 71 |  .  I $G(NURCURSW),+NURSCLAS'>0!'(+$G(^NURSA(214.6,+NURSCLAS,0))[DT) Q
 | 
|---|
| 72 |  .  ;I '$G(NURCURSW),+$G(^NURSA(214.6,+NURSCLAS,0))[DT Q
 | 
|---|
| 73 |  .  D
 | 
|---|
| 74 |  .  .  I $E(IOST)="C",'$R(10) W "."
 | 
|---|
| 75 |  .  .  S N1=$S(VADM(1)'="":VADM(1),1:"  BLANK")
 | 
|---|
| 76 |  .  .  S NCAT=$S(NURSCLAS'="":$P(^NURSA(214.6,NURSCLAS,0),U,3),1:"")
 | 
|---|
| 77 |  .  .  S NS1=$S($D(^NURSF(214,DFN,0)):$P(^(0),"^",4),1:""),NS1(0)=$S(NURSCLAS="":"",$D(^NURSA(214.6,NURSCLAS,0)):$P(^(0),"^",9),1:"") S:NS1'=NS1(0)&(NS1'="") NURSCLAS=""
 | 
|---|
| 78 |  .  .  I NS1'="",$D(^NURSF(213.3,NS1,0)),$P(^NURSF(213.3,NS1,0),"^",1)'="" S NBEDS=$S($P($G(^NURSF(213.3,NS1,0)),"^")'="":$P(^(0),"^"),1:"  BLANK")
 | 
|---|
| 79 |  .  .  S NPWARD=NURSW1 D EN6^NURSAUTL S NURSWARD=$S(NPWARD'="":NPWARD,1:"  BLANK")
 | 
|---|
| 80 |  .  .  S ^TMP($J,NURFAC(2),NURSWARD,NBEDS,N1,DFN_"--"_NURSCLAS)=""
 | 
|---|
| 81 |  .  .  I NCAT'="" S NTC=NTC+1,NTC(NCAT)=NTC(NCAT)+1
 | 
|---|
| 82 |  .  .  Q
 | 
|---|
| 83 |  .  Q
 | 
|---|
| 84 |  Q
 | 
|---|
| 85 | CAT ; CATEGORY TOTAL DISPLAY
 | 
|---|
| 86 |  W !!,?70,"PATIENTS",!,?29,"I      II      III      IV       V       CLASSIFIED",!,?27,"---",?35,"---",?44,"---",?52,"---",?60,"---",?70,"----------"
 | 
|---|
| 87 |  W !,"CATEGORY TOTALS:",?27,$J(NTC(1),3),?35,$J(NTC(2),3),?44,$J(NTC(3),3),?52,$J(NTC(4),3),?60,$J(NTC(5),3),?70,$J(NTC,10),!
 | 
|---|
| 88 |  Q
 | 
|---|