NURARCR1 ;HIRMFO/MD,FT-CONTINUATION VIEW PRINT OF PATIENT CLASSIFICATION ;8/9/96 11:32
;;4.0;NURSING SERVICE;;Apr 25, 1997
WRITE S NL1="" F S NL1=$O(^TMP($J,NL1)) Q:NL1="" D HEADER:NURSW1,W1 Q:NURQUIT
Q
W1 S NDT="" F S NDT=$O(^TMP($J,NL1,NDT)) Q:NDT="" D W2 Q:NURQUIT
Q
W2 F DA(1)=0:0 S DA(1)=$O(^TMP($J,NL1,NDT,DA(1))) Q:DA(1)'>0 D DLN Q:NURQUIT
Q
DLN I ($Y>(IOSL-6)!('NURSW1)) D HEADER Q:NURQUIT
S NDATA=^NURSA(214.6,DA(1),0),Y=NDT D:+Y D^DIQ W !,Y,?26,$P(NDATA,"^",3)
;F X=1:1:$L($P(NDATA,"^",4)) W ?(31+((X-1)*2)),$E($P(NDATA,"^",4),X)
W ?31,$P(NDATA,U,4)
W ?45,$S($P(NDATA,"^",9)="":"",'$D(^NURSF(213.3,$P(NDATA,"^",9),1)):"",1:$P(^(1),"^",1))
W ?55,$E($P(NDATA,"^",7),1,25) I $L($P(NDATA,"^",7))>25 W !,?55,$E($P(NDATA,"^",7),26,50)
Q
I $E(IOST)="C",NURSW1 D ENDPG^NURSUT1 S:NUROUT NURQUIT=+NUROUT Q:NURQUIT
S NURPAGE=NURPAGE+1,Y=DT D:+Y D^DIQ W:$E(IOST)="C"!(NURPAGE>1) @IOF
W !!,Y W:NURSSEL ?17 W:'NURSSEL ?20 W "INDIVIDUAL PATIENT CLASSIFICATION REPORT",$S(NURSSEL:" BY WARD",1:""),?71,"PAGE: ",NURPAGE
W !,$$REPEAT^XLFSTR("-",80)
S NURSW1=1,NADMT=$S($P(VAIN(7),"^",2)'="":$P(VAIN(7),"^",2),1:"")
S NPWARD=$S($D(^NURSF(214,DFN,0)):+$P(^(0),"^",3),1:"") D EN6^NURSAUTL
W !,"PATIENT NAME : ",$E(N1,1,20),?57,"SSN: ",SSN,!,"ADMISSION DATE: ",NADMT,?57,"WARD: ",NPWARD
W !,?45,"BED"
W !,?5,"DATE/TIME",?25,"NO.",?31,"FACTORS",?45,"SECT",?55,"COMMENTS"
W !,?5,"---------",?25,"---",?31,"-------",?45,"----",?55,"--------"
W !!,?5,"CLASSIFICATION WARD: ",$S(NL1'=" BLANK":NL1,1:""),!
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HNURARCR1 1568 printed Oct 16, 2024@18:20:27 Page 2
NURARCR1 ;HIRMFO/MD,FT-CONTINUATION VIEW PRINT OF PATIENT CLASSIFICATION ;8/9/96 11:32
+1 ;;4.0;NURSING SERVICE;;Apr 25, 1997
WRITE SET NL1=""
FOR
SET NL1=$ORDER(^TMP($JOB,NL1))
if NL1=""
QUIT
if NURSW1
DO HEADER
DO W1
if NURQUIT
QUIT
+1 QUIT
W1 SET NDT=""
FOR
SET NDT=$ORDER(^TMP($JOB,NL1,NDT))
if NDT=""
QUIT
DO W2
if NURQUIT
QUIT
+1 QUIT
W2 FOR DA(1)=0:0
SET DA(1)=$ORDER(^TMP($JOB,NL1,NDT,DA(1)))
if DA(1)'>0
QUIT
DO DLN
if NURQUIT
QUIT
+1 QUIT
DLN IF ($Y>(IOSL-6)!('NURSW1))
DO HEADER
if NURQUIT
QUIT
+1 SET NDATA=^NURSA(214.6,DA(1),0)
SET Y=NDT
if +Y
DO D^DIQ
WRITE !,Y,?26,$PIECE(NDATA,"^",3)
+2 ;F X=1:1:$L($P(NDATA,"^",4)) W ?(31+((X-1)*2)),$E($P(NDATA,"^",4),X)
+3 WRITE ?31,$PIECE(NDATA,U,4)
+4 WRITE ?45,$SELECT($PIECE(NDATA,"^",9)="":"",'$DATA(^NURSF(213.3,$PIECE(NDATA,"^",9),1)):"",1:$PIECE(^(1),"^",1))
+5 WRITE ?55,$EXTRACT($PIECE(NDATA,"^",7),1,25)
IF $LENGTH($PIECE(NDATA,"^",7))>25
WRITE !,?55,$EXTRACT($PIECE(NDATA,"^",7),26,50)
+6 QUIT
+1 IF $EXTRACT(IOST)="C"
IF NURSW1
DO ENDPG^NURSUT1
if NUROUT
SET NURQUIT=+NUROUT
if NURQUIT
QUIT
+2 SET NURPAGE=NURPAGE+1
SET Y=DT
if +Y
DO D^DIQ
if $EXTRACT(IOST)="C"!(NURPAGE>1)
WRITE @IOF
+3 WRITE !!,Y
if NURSSEL
WRITE ?17
if 'NURSSEL
WRITE ?20
WRITE "INDIVIDUAL PATIENT CLASSIFICATION REPORT",$SELECT(NURSSEL:" BY WARD",1:""),?71,"PAGE: ",NURPAGE
+4 WRITE !,$$REPEAT^XLFSTR("-",80)
+5 SET NURSW1=1
SET NADMT=$SELECT($PIECE(VAIN(7),"^",2)'="":$PIECE(VAIN(7),"^",2),1:"")
+6 SET NPWARD=$SELECT($DATA(^NURSF(214,DFN,0)):+$PIECE(^(0),"^",3),1:"")
DO EN6^NURSAUTL
+7 WRITE !,"PATIENT NAME : ",$EXTRACT(N1,1,20),?57,"SSN: ",SSN,!,"ADMISSION DATE: ",NADMT,?57,"WARD: ",NPWARD
+8 WRITE !,?45,"BED"
+9 WRITE !,?5,"DATE/TIME",?25,"NO.",?31,"FACTORS",?45,"SECT",?55,"COMMENTS"
+10 WRITE !,?5,"---------",?25,"---",?31,"-------",?45,"----",?55,"--------"
+11 WRITE !!,?5,"CLASSIFICATION WARD: ",$SELECT(NL1'=" BLANK":NL1,1:""),!
+12 QUIT
