Routine: NURCHSUM

NURCHSUM ;HIRMFO/YH,RM-HEALTH SUMMARY REPORT BY NUR WARD/ROOM/PT ;3/29/96

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

EN1 ;PATIENT HEALTH SUMMARY REPORT BY WARD/ROOM/PT

 S X="GMTSDVR" X ^%ZOSF("TEST") I '$T W !,"YOU NEED HEALTH SUMMARY VERSION 2.5 TO RUN THIS REPORT",! G Q

 K GMTYP D SELTYP^GMTSDVR G:'+$G(GMTYP(1)) Q

 S NACT=0 D ^NURCUT0 G:NURQUIT Q D HSUM

Q K NACT,NN,DFN,NURQUIT,NPWARD,NURMBD,NULL,NUREDB,NURWARD D ^%ZISC D KILL2

HSUM ;CALL HEALTH SUMMARY PACKAGE FOR REPORT

 K ZTSK,IOP,%ZIS S %ZIS="PQ" D ^%ZIS Q:POP

 I $D(IO("Q")) K IO("Q"),ZTSAVE D LOOP S ZTRTN="START^NURCHSUM",ZTDESC="HEALTH SUMMARY",ZTIO=ION_";"_IOM_";"_IOSL D ^%ZTLOAD W !,$S($D(ZTSK):"Request Queued!",1:"Request Cancelled!") D KILL,KILL2 Q

START ;

 I "Pp"[NUREDB Q:DFN'>0  D ENX^GMTSDVR(DFN,+GMTYP(1)) Q

 F DFN=0:0 S DFN=$O(^NURSF(214,"AF","A",NURWARD,DFN)) Q:DFN'>0!($D(DIROUT))  D WARDPT

 I '$D(NURPT) W !,"No patients for this report",! Q

 S NRM="" F  S NRM=$O(NURPT(NRM)) Q:NRM=""!($D(DIROUT))  S NBD="" F  S NBD=$O(NURPT(NRM,NBD)) Q:NBD=""!($D(DIROUT))  S DFN=0 F  S DFN=$O(NURPT(NRM,NBD,DFN)) Q:DFN'>0!($D(DIRPOUT))  D ENX^GMTSDVR(DFN,+GMTYP(1)) D:$E(IOST)="C" STOP Q:$D(DIROUT)

WARDPT ;

 D PT Q:"Ss"[NUREDB&($S(NURBED="":1,1:'$D(NRMBD(NURBED))))!(NURNAM="")

 S NRM="BLANK",NBD="BLANK" S:NURBED'="" NRM=$P(NURBED,"-"),NBD=$P(NURBED,"-",2) S NURPT(NRM,NBD,DFN)="" Q

LOOP ;

 F X="NURQUIT","NRMBD(","NPWARD","NUREDB","DFN","NURWARD","GMT*","ENTRY" S ZTSAVE(X)=""

STOP ;

 W !,"Press return to display data for the next patient or ""^"" to stop " R X:DTIME

 I '$T!(X="^") S DIROUT=1 Q

KILL ;

 K ZTSK,ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSAVE D KILL2 Q

KILL2 ;

 K GMW,GMX,GMTSEG,GMTSEGC,GMTSEGI,GMTSTITL,GMTYP,NRMBD,NRM,NURBED,NURNAM,NURPT,NBD Q

PT ;

 D 1^VADPT S NURBED=$P($P(VAIN(5),"^"),"-",1,2),NURNAM=$P(VADM(1),"^") D KVAR^VADPT Q

NURCHSUM  ;HIRMFO/YH,RM-HEALTH SUMMARY REPORT BY NUR WARD/ROOM/PT ;3/29/96

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

EN1       ;PATIENT HEALTH SUMMARY REPORT BY WARD/ROOM/PT

 +1        SET X="GMTSDVR"

           XECUTE ^%ZOSF("TEST")

           IF '$TEST

               WRITE !,"YOU NEED HEALTH SUMMARY VERSION 2.5 TO RUN THIS REPORT",!

               GOTO Q

 +2        KILL GMTYP

           DO SELTYP^GMTSDVR

           IF '+$GET(GMTYP(1))

               GOTO Q

 +3        SET NACT=0

           DO ^NURCUT0

           IF NURQUIT

               GOTO Q

           DO HSUM

Q          KILL NACT,NN,DFN,NURQUIT,NPWARD,NURMBD,NULL,NUREDB,NURWARD

           DO ^%ZISC

           DO KILL2

 +1        QUIT

HSUM      ;CALL HEALTH SUMMARY PACKAGE FOR REPORT

 +1        KILL ZTSK,IOP,%ZIS

           SET %ZIS="PQ"

           DO ^%ZIS

           IF POP

               QUIT

 +2        IF $DATA(IO("Q"))

               KILL IO("Q"),ZTSAVE

               DO LOOP

               SET ZTRTN="START^NURCHSUM"

               SET ZTDESC="HEALTH SUMMARY"

               SET ZTIO=ION_";"_IOM_";"_IOSL

               DO ^%ZTLOAD

               WRITE !,$SELECT($DATA(ZTSK):"Request Queued!",1:"Request Cancelled!")

               DO KILL

               DO KILL2

               QUIT

START     ;

 +1        IF "Pp"[NUREDB

               IF DFN'>0

                   QUIT

               DO ENX^GMTSDVR(DFN,+GMTYP(1))

               QUIT

 +2        FOR DFN=0:0

               SET DFN=$ORDER(^NURSF(214,"AF","A",NURWARD,DFN))

               IF DFN'>0!($DATA(DIROUT))

                   QUIT

               DO WARDPT

 +3        IF '$DATA(NURPT)

               WRITE !,"No patients for this report",!

               QUIT

 +4        SET NRM=""

FOR

               SET NRM=$ORDER(NURPT(NRM))

               IF NRM=""!($DATA(DIROUT))

                   QUIT

               SET NBD=""

FOR

                   SET NBD=$ORDER(NURPT(NRM,NBD))

                   IF NBD=""!($DATA(DIROUT))

                       QUIT

                   SET DFN=0

FOR

                       SET DFN=$ORDER(NURPT(NRM,NBD,DFN))

                       IF DFN'>0!($DATA(DIRPOUT))

                           QUIT

                       DO ENX^GMTSDVR(DFN,+GMTYP(1))

                       IF $EXTRACT(IOST)="C"

                           DO STOP

                       IF $DATA(DIROUT)

                           QUIT

 +5        QUIT

WARDPT    ;

 +1        DO PT

           IF "Ss"[NUREDB&($SELECT(NURBED=""

               QUIT

 +2        SET NRM="BLANK"

           SET NBD="BLANK"

           IF NURBED'=""

               SET NRM=$PIECE(NURBED,"-")

               SET NBD=$PIECE(NURBED,"-",2)

           SET NURPT(NRM,NBD,DFN)=""

           QUIT

 +3        QUIT

LOOP      ;

 +1        FOR X="NURQUIT","NRMBD(","NPWARD","NUREDB","DFN","NURWARD","GMT*","ENTRY"

               SET ZTSAVE(X)=""

 +2        QUIT

STOP      ;

 +1        WRITE !,"Press return to display data for the next patient or ""^"" to stop "

           READ X:DTIME

 +2        IF '$TEST!(X="^")

               SET DIROUT=1

               QUIT

 +3        QUIT

KILL      ;

 +1        KILL ZTSK,ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSAVE

           DO KILL2

           QUIT

KILL2     ;

 +1        KILL GMW,GMX,GMTSEG,GMTSEGC,GMTSEGI,GMTSTITL,GMTYP,NRMBD,NRM,NURBED,NURNAM,NURPT,NBD

           QUIT

PT        ;

 +1        DO 1^VADPT

           SET NURBED=$PIECE($PIECE(VAIN(5),"^"),"-",1,2)

           SET NURNAM=$PIECE(VADM(1),"^")

           DO KVAR^VADPT

           QUIT

NURCHSUM.m