NURARCR1.m

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

HEADER ; HEADINGS

 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 

HEADER    ; HEADINGS

 +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