- 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
- Q
- 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)
- Q
- 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
- Q
- LOOP ;
- F X="NURQUIT","NRMBD(","NPWARD","NUREDB","DFN","NURWARD","GMT*","ENTRY" S ZTSAVE(X)=""
- Q
- STOP ;
- W !,"Press return to display data for the next patient or ""^"" to stop " R X:DTIME
- I '$T!(X="^") S DIROUT=1 Q
- 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
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HNURCHSUM 1848 printed Feb 18, 2025@23:46:58 Page 2
- 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