- 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
- 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
