Routine: NURCES01

NURCES01 ;HIRMFO/YH-END OF SHIFT REPORT PART 1/2 ;12/6/96

 ;;4.0;NURSING SERVICE;;Apr 25, 1997

PRINT1 ;

 D ^NURSAPCH

 S GMROUT=0 I GPACK D SETARRY^NURCES2

 I GFH D DIET^NURCES4

 D EN6^NURSCUTL S NURSCLAS("CL")=1 D EN2^NURSCUTL

 I NURSCLAS S NDATA(1)=$S($D(^NURSA(214.6,NURSCLAS,0)):^(0),1:"") S NURFACT=$S($P(NDATA(1),"^",4)'="":$P(NDATA(1),"^",4),1:""),NURCAT=$S(+$P(NDATA(1),"^",3):$P(NDATA(1),"^",3),1:""),NCOM=$S($P(NDATA(1),"^",7)'="":$P(NDATA(1),"^",7),1:"")

 I $D(^NURSF(214,DFN,0)) S NDATA(2)=^(0),NSEC=$S('$D(NDATA(2)):"",'$P(NDATA(2),"^",4):"",'$D(^NURSF(213.3,$P(NDATA(2),"^",4),0)):"",1:$P(^NURSF(213.3,$P(NDATA(2),"^",4),1),"^"))

 D PTDATA^NURCES2,PTPROB^NURCES1 Q:NURQUIT

 I GPACK,$D(NURIV),NURIV>0 S N=0 F  S N=$O(NURIV(N)) Q:N'>0  D

 . D FITLINE^NURCES5(NURIV(N),62,.NPR)

 I GPACK,$D(NURTUBE),NURTUBE>0 S NPR=NPR+1,NPR(NPR)="Last tube changed:",GSITE="" F  S GSITE=$O(NURTUBE(GSITE)) Q:GSITE=""  S Y=NURTUBE(GSITE) X ^DD("DD") S NPR=NPR+1,NPR(NPR)="  "_GSITE_" on "_$P(Y,":",1,2)

 K NURIV,NURTUBE,GLEFT,GSITE,GSAVEH S NN(1)=2 S:NPR>2&(NOPT=1) NN(1)=NPR S:NADM>NN(1) NN(1)=NADM S:NPT>NN(1) NN(1)=NPT S:NVM>NN(1) NN(1)=NVM F NN=1:1:NN(1) D:$Y>(IOSL-8) HEADER^NURCES2 Q:NURQUIT  D PRINT2^NURCES2 Q:NURQUIT

 I NOPT=2 D PART2

 Q:NURQUIT  W $S(NOPT=1:NURX,NOPT=2:$E(NURX,1,79),1:NURX),!

PART2 ;

 W !,?10,"Patient Problems:",!

 I NPR>0 F NN=1:1:NPR W ?12,NPR(NN),! D:$Y>(IOSL-8) HEADER^NURCES2 Q:NURQUIT

 I NPR=0 W ?49,"|",?64,"|",! D:$Y>(IOSL-8) HEADER^NURCES2

NURCES01  ;HIRMFO/YH-END OF SHIFT REPORT PART 1/2 ;12/6/96

 +1       ;;4.0;NURSING SERVICE;;Apr 25, 1997

PRINT1    ;

 +1        DO ^NURSAPCH

 +2        SET GMROUT=0

           IF GPACK

               DO SETARRY^NURCES2

 +3        IF GFH

               DO DIET^NURCES4

 +4        DO EN6^NURSCUTL

           SET NURSCLAS("CL")=1

           DO EN2^NURSCUTL

 +5        IF NURSCLAS

               SET NDATA(1)=$SELECT($DATA(^NURSA(214.6,NURSCLAS,0)):^(0),1:"")

               SET NURFACT=$SELECT($PIECE(NDATA(1),"^",4)'="":$PIECE(NDATA(1),"^",4),1:"")

               SET NURCAT=$SELECT(+$PIECE(NDATA(1),"^",3):$PIECE(NDATA(1),"^",3),1:"")

               SET NCOM=$SELECT($PIECE(NDATA(1),"^",7)'="":$PIECE(NDATA(1),"^",7),1:"")

 +6        IF $DATA(^NURSF(214,DFN,0))

               SET NDATA(2)=^(0)

               SET NSEC=$SELECT('$DATA(NDATA(2)):"",'$PIECE(NDATA(2),"^",4):"",'$DATA(^NURSF(213.3,$PIECE(NDATA(2),"^",4),0)):"",1:$PIECE(^NURSF(213.3,$PIECE(NDATA(2),"^",4),1),"^"))

 +7        DO PTDATA^NURCES2

           DO PTPROB^NURCES1

           IF NURQUIT

               QUIT

 +8        IF GPACK

               IF $DATA(NURIV)

                   IF NURIV>0

                       SET N=0

FOR

                           SET N=$ORDER(NURIV(N))

                           IF N'>0

                               QUIT

                           Begin DoDot:1

 +9                            DO FITLINE^NURCES5(NURIV(N),62,.NPR)

                           End DoDot:1

 +10       IF GPACK

               IF $DATA(NURTUBE)

                   IF NURTUBE>0

                       SET NPR=NPR+1

                       SET NPR(NPR)="Last tube changed:"

                       SET GSITE=""

FOR

                           SET GSITE=$ORDER(NURTUBE(GSITE))

                           IF GSITE=""

                               QUIT

                           SET Y=NURTUBE(GSITE)

                           XECUTE ^DD("DD")

                           SET NPR=NPR+1

                           SET NPR(NPR)="  "_GSITE_" on "_$PIECE(Y,":",1,2)

 +11       KILL NURIV,NURTUBE,GLEFT,GSITE,GSAVEH

           SET NN(1)=2

           IF NPR>2&(NOPT=1)

               SET NN(1)=NPR

           IF NADM>NN(1)

               SET NN(1)=NADM

           IF NPT>NN(1)

               SET NN(1)=NPT

           IF NVM>NN(1)

               SET NN(1)=NVM

           FOR NN=1:1:NN(1)

               IF $Y>(IOSL-8)

                   DO HEADER^NURCES2

               IF NURQUIT

                   QUIT

               DO PRINT2^NURCES2

               IF NURQUIT

                   QUIT

 +12       IF NOPT=2

               DO PART2

 +13       IF NURQUIT

               QUIT

           WRITE $SELECT(NOPT=1:NURX,NOPT=2:$EXTRACT(NURX,1,79),1:NURX),!

 +14       QUIT

PART2     ;

 +1        WRITE !,?10,"Patient Problems:",!

 +2        IF NPR>0

               FOR NN=1:1:NPR

                   WRITE ?12,NPR(NN),!

                   IF $Y>(IOSL-8)

                       DO HEADER^NURCES2

                   IF NURQUIT

                       QUIT

 +3        IF NPR=0

               WRITE ?49,"|",?64,"|",!

               IF $Y>(IOSL-8)

                   DO HEADER^NURCES2

 +4        QUIT

NURCES01.m