- NURCVPR0 ;HIRMFO/YH,FT-VITALS/MEASUREMENTS RESULTS REPORTING ;5/4/99 14:43
- ;;4.0;NURSING SERVICE;**5,21,23,24**;Apr 25, 1997;
- EN1 ;ENTER FROM NURCPP-VIT-SF511 OPTION TO PRINT SF 511, B/P OR WEIGHT CHART
- ;CALL ^NURCVUT0 TO SELECT PATIENT BY WARD, ROOM OR SINGLE PATIENT, THEN CALL
- ; ^NURCAS2 TO STORE PATIENT INFORMATION IN ^TMP($J,"NURCEN")
- ;CALL EN5^GMRVSR0 WITH FOLLOWING VALUES:
- ; DFN = PATIENT NUMBER
- ; GMRDATE = START DATE^FINISH DATE OF REPORT^TYPE OF GRAPH
- ; GMRVWLO = NURSING LOCATION
- S (NGRAPH,NURQUIT)=0 D SELECT^NURCVPR1(.NGRAPH) G:NGRAPH'>0 Q2 D ^NURCVUT0 I NURQUIT!(NUREDB["S"&'$D(NRMBD)) G Q2
- D DATE I NURQUIT G Q2
- I NGRAPH=5 S X="GMRVKPN0" X ^%ZOSF("TEST") I $T S NUR5FLG=1
- I NGRAPH=5,'$D(NUR5FLG) W !!,"PAIN CHART must be queued to a HP Laser printer",! G DEV
- W !!,"This report must be queued to a line printer",!,"or a slave printer with 132 columns",!,"or a Kyocera/HP Laser printer",!
- DEV S %ZIS="NQ",%ZIS("B")="" W ! D ^%ZIS G:POP Q2
- N NURDEV S NURDEV=ION_";"_IOST_";"_IOM_";"_IOSL
- I IOM'>131 W !!,"Sorry, you must select a DEVICE that can print 132 columns. Try again." G DEV ;device must be 132 columns
- ;I '(IOST?1"P".E&$D(IO("Q"))),'$D(IO("S")) D WRT1^NURCVPR1 G DEV
- I NGRAPH=5,'$D(NUR5FLG),$$UP^XLFSTR(IOST)'["HPLASER" W !,"PAIN CHART uses HP Laser printer only." G DEV
- I '$D(IO("Q")) S IOP=NURDEV K %ZIS D ^%ZIS G Q2:POP,START
- I $D(IO("Q")) W ! S ZTDESC="V/M GRAPHIC REPORTS",ZTIO=ION,ZTRTN="START^NURCVPR0" F G="NUREDB","NURSTRT","NURFIN","NPWARD","NURWARD","NURQUIT","NRMBD(","DFN","NGRAPH","GSTRFIN" S ZTSAVE(G)=""
- I $D(IO("Q")) D ^%ZTLOAD,HOME^%ZIS D Q2 Q
- START ; ENTRY TO PRINT THIS REPORT AFTER IT HAS BEEN QUEUED
- ; NOTE: THIS REPORT MUST BE QUEUED TO A PRINTER.
- I NGRAPH=5,'$D(IO("Q")),$$UP^XLFSTR(IOST)'["HPLASER" S NURPERR=0 D Q:NURPERR
- .S X="GMRVKPN0" X ^%ZOSF("TEST")
- .I $T,$$UP^XLFSTR(IOST)'["KYOCERA" W !,"Sorry, you must select a Kyocera or HP Laser printer for the Pain Chart." S NURPERR=1 Q
- .I '$T,$$UP^XLFSTR(IOST)'["KYOCERA" W !,"Sorry, you must select a HP Laser printer." S NURPERR=1 Q
- .Q
- K ^TMP($J,"NURCEN") S GFLAG=0 D ^NURCAS2 I '$D(^TMP($J,"NURCEN")) W !,"NO DATA FOR THIS REPORT" G Q1
- I NUREDB="P" S NPWARD=$S($D(^NURSF(214,DFN,0)):$P(^(0),"^",3),1:"") I NPWARD'="" D EN6^NURSAUTL
- S:NPWARD'="" GMRVWLO=NPWARD
- S GMRDATE=NURSTRT_"^"_NURFIN_"^"_NGRAPH,NURRM=""
- F S NURRM=$O(^TMP($J,"NURCEN",NURRM)) Q:NURRM=""!NURQUIT S NBED="" F S NBED=$O(^TMP($J,"NURCEN",NURRM,NBED)) Q:NBED=""!NURQUIT S NURNAM="" F S NURNAM=$O(^TMP($J,"NURCEN",NURRM,NBED,NURNAM)) Q:NURNAM=""!NURQUIT D REPT
- G Q1
- REPT ;
- Q:'$D(^TMP($J,"NURCEN",NURRM,NBED,NURNAM)) S DFN=+$P(^(NURNAM),"^") D:DFN>0 EN5^GMRVSR0
- Q
- DATE S %DT("A")="Start DATE (TIME optional): ",%DT("B")="T-7",%DT="AETX" D ^%DT K %DT I +Y'>0 S NURQUIT=1 Q
- S NURSTRT=+Y
- S %DT("A")="Go to DATE (TIME optional): ",%DT="AETX",%DT("B")="NOW" D ^%DT K %DT I +Y'>0 S NURQUIT=1 Q
- I $P(Y,".",2)'>0,Y=DT D NOW^%DTC S Y=%
- I $P(Y,".",2)'>0 S Y=Y_$S(Y[".":"2400",1:".2400")
- S (X1,NURFIN)=+Y,X2=NURSTRT D ^%DTC
- I X<0!(X=0&(((+("."_$P(NURFIN,".",2))*10000)-((+("."_$P(NURSTRT,".",2))*10000)))'>0)) W !?5,"Ending date of range needs to be greater that starting date.",!?5,$C(7),"PLEASE REENTER!!" G DATE
- S Y=NURSTRT X ^DD("DD") S GSTRFIN=Y S Y=NURFIN X ^DD("DD") S GSTRFIN=GSTRFIN_" - "_Y
- Q
- Q1 D Q2^GMRVSR0
- Q2 K NURLOCSW,NGRAPH,NURP,ZTSK,ZTDESC,X1,X2 D ^%ZISC
- K ^TMP($J),DFN,GMRDATE,NAME,NBED,NI,NN,NROOM,NURRM,NRMBD,NURNAM,GMRDT,NIEF,NWRD,NURFIN,NURSTRT,NUR5FLG,NUREDB,NPWARD,NURWARD,X,Y,GMROUT,NURQUIT,NORM,NUREDB,GMRVWLO,G,ND1,NDA,NURQUEUE,NURI,NURLEN,NURRMST,NURPERR
- K NURSX,NURSY,NURX,NWLOC,%W,%T,%Y1,VAROOT
- K NURMDSW,GSTRFIN Q
- EN2 ;VITAL SIGNS DISPLAY BY INDIVIDUAL PATIENT
- ;ENTRY POINT FOR OPTION NURCPP-VIT-DISP
- D EN2^GMRVDS0
- Q
- EN3 ;REPORT OF VITALS ENTERED IN ERROR FOR A PATIENT
- ;ENTRY POINT FOR OPTION NURCPP-VIT-ERROR
- D EN1^GMRVER0
- Q
- EN4 ;CUMULATIVE VITALS REPORT BY WARD/ROOM/PATIENT
- ;ENTRY POINT FOR OPTION NURCPP-VIT-CUM
- S NURQUIT=0 D ^NURCVUT0 G:NURQUIT!(NUREDB["S"&'$D(NRMBD)) Q4
- K ^TMP($J,"NURCEN") D ^NURCAS2 I '$D(^TMP($J,"NURCEN")) W !,"NO PATIENT FOR THIS REPORT" G Q4
- S GMRX="",GMROUT=0 I "Pp"[NUREDB D INP^VADPT S:VAIN(7)'="" GMRX=$P($P(VAIN(7),"^",2),"@")
- D DATE^GMRVSC0 G:GMROUT Q4 S ZTRTN="START4^NURCVPR0" F G="GMRVSDT","GMRVFDT","DFN","^TMP($J,","NUREDB","GMROUT" S ZTSAVE(G)=""
- D EN7^NURSUT0 I POP!($D(ZTSK)) G Q4
- START4 S GMRPG=0 U IO
- S NURRM=""
- F S NURRM=$O(^TMP($J,"NURCEN",NURRM)) Q:NURRM=""!($G(GMROUT)) S NBED="" F S NBED=$O(^TMP($J,"NURCEN",NURRM,NBED)) Q:NBED=""!($G(GMROUT)) S NURNAM="" F S NURNAM=$O(^TMP($J,"NURCEN",NURRM,NBED,NURNAM)) Q:NURNAM=""!($G(GMROUT)) D REPORT
- Q4 D Q2,KVAR^VADPT K GFLAG,GMROUT,GMRPG,GMRVSDT,GMRVFDT,GMRX,VA Q
- REPORT S DFN=+$P(^TMP($J,"NURCEN",NURRM,NBED,NURNAM),"^") D:DFN>0 EN5^GMRVSC0
- Q
- EN5 ;DISPLAY VITAL SIGNS BY LOCATION
- ;ENTRY POINT FOR NURCPP-VIT-WARD
- ; LOOKUP FILE 211.4 TO GET NURSING LOCATION
- ;OUTPUT VARIABLES: ^TMP($J,ROOM-BED,PATIENT NAME,DFN)=""
- ; DFN = POINTER TO FILE 2
- ; GMRVWLO = NURSING LOCATION
- ;EN3^GMRVSL0 IS CALLED TO PRINT VITALS FOR THE PATIENTS IN ^TMP($J)
- S (NURLOCSW,NURQUIT)=0,NUREDB="U" D WARDSEL^NURCUT0 I NURQUIT G Q2
- I '$D(^NURSF(211.4,+$G(NURWARD),3,0))!($O(^(0))'>0) W !,"**** NO DATA FOR UNIT : ",NPWARD G Q2
- S ZTRTN="START2^NURCVPR0",ZTDESC="Unit Vital/Measurements Report" F G="NURQUIT","NURWARD","NPWARD" S ZTSAVE(G)=""
- D EN7^NURSUT0 G:POP!($D(ZTSK)) Q2
- START2 ;
- F DFN=0:0 S DFN=$O(^NURSF(214,"AF","A",NURWARD,DFN)) Q:DFN'>0 D 1^VADPT S ^TMP($J,$S(VAIN(5)'="":VAIN(5),1:" BLANK"),$S(VADM(1)'="":VADM(1),1:" BLANK"),DFN)=""
- S GMRVWLO=NPWARD,GMRVHLOC=$P($G(^DIC(42,+$G(VAIN(4)),44)),"^") D EN3^GMRVDS1
- G Q2
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HNURCVPR0 5819 printed Feb 18, 2025@23:47:26 Page 2
- NURCVPR0 ;HIRMFO/YH,FT-VITALS/MEASUREMENTS RESULTS REPORTING ;5/4/99 14:43
- +1 ;;4.0;NURSING SERVICE;**5,21,23,24**;Apr 25, 1997;
- EN1 ;ENTER FROM NURCPP-VIT-SF511 OPTION TO PRINT SF 511, B/P OR WEIGHT CHART
- +1 ;CALL ^NURCVUT0 TO SELECT PATIENT BY WARD, ROOM OR SINGLE PATIENT, THEN CALL
- +2 ; ^NURCAS2 TO STORE PATIENT INFORMATION IN ^TMP($J,"NURCEN")
- +3 ;CALL EN5^GMRVSR0 WITH FOLLOWING VALUES:
- +4 ; DFN = PATIENT NUMBER
- +5 ; GMRDATE = START DATE^FINISH DATE OF REPORT^TYPE OF GRAPH
- +6 ; GMRVWLO = NURSING LOCATION
- +7 SET (NGRAPH,NURQUIT)=0
- DO SELECT^NURCVPR1(.NGRAPH)
- if NGRAPH'>0
- GOTO Q2
- DO ^NURCVUT0
- IF NURQUIT!(NUREDB["S"&'$DATA(NRMBD))
- GOTO Q2
- +8 DO DATE
- IF NURQUIT
- GOTO Q2
- +9 IF NGRAPH=5
- SET X="GMRVKPN0"
- XECUTE ^%ZOSF("TEST")
- IF $TEST
- SET NUR5FLG=1
- +10 IF NGRAPH=5
- IF '$DATA(NUR5FLG)
- WRITE !!,"PAIN CHART must be queued to a HP Laser printer",!
- GOTO DEV
- +11 WRITE !!,"This report must be queued to a line printer",!,"or a slave printer with 132 columns",!,"or a Kyocera/HP Laser printer",!
- DEV SET %ZIS="NQ"
- SET %ZIS("B")=""
- WRITE !
- DO ^%ZIS
- if POP
- GOTO Q2
- +1 NEW NURDEV
- SET NURDEV=ION_";"_IOST_";"_IOM_";"_IOSL
- +2 ;device must be 132 columns
- IF IOM'>131
- WRITE !!,"Sorry, you must select a DEVICE that can print 132 columns. Try again."
- GOTO DEV
- +3 ;I '(IOST?1"P".E&$D(IO("Q"))),'$D(IO("S")) D WRT1^NURCVPR1 G DEV
- +4 IF NGRAPH=5
- IF '$DATA(NUR5FLG)
- IF $$UP^XLFSTR(IOST)'["HPLASER"
- WRITE !,"PAIN CHART uses HP Laser printer only."
- GOTO DEV
- +5 IF '$DATA(IO("Q"))
- SET IOP=NURDEV
- KILL %ZIS
- DO ^%ZIS
- if POP
- GOTO Q2
- GOTO START
- +6 IF $DATA(IO("Q"))
- WRITE !
- SET ZTDESC="V/M GRAPHIC REPORTS"
- SET ZTIO=ION
- SET ZTRTN="START^NURCVPR0"
- FOR G="NUREDB","NURSTRT","NURFIN","NPWARD","NURWARD","NURQUIT","NRMBD(","DFN","NGRAPH","GSTRFIN"
- SET ZTSAVE(G)=""
- +7 IF $DATA(IO("Q"))
- DO ^%ZTLOAD
- DO HOME^%ZIS
- DO Q2
- QUIT
- START ; ENTRY TO PRINT THIS REPORT AFTER IT HAS BEEN QUEUED
- +1 ; NOTE: THIS REPORT MUST BE QUEUED TO A PRINTER.
- +2 IF NGRAPH=5
- IF '$DATA(IO("Q"))
- IF $$UP^XLFSTR(IOST)'["HPLASER"
- SET NURPERR=0
- Begin DoDot:1
- +3 SET X="GMRVKPN0"
- XECUTE ^%ZOSF("TEST")
- +4 IF $TEST
- IF $$UP^XLFSTR(IOST)'["KYOCERA"
- WRITE !,"Sorry, you must select a Kyocera or HP Laser printer for the Pain Chart."
- SET NURPERR=1
- QUIT
- +5 IF '$TEST
- IF $$UP^XLFSTR(IOST)'["KYOCERA"
- WRITE !,"Sorry, you must select a HP Laser printer."
- SET NURPERR=1
- QUIT
- +6 QUIT
- End DoDot:1
- if NURPERR
- QUIT
- +7 KILL ^TMP($JOB,"NURCEN")
- SET GFLAG=0
- DO ^NURCAS2
- IF '$DATA(^TMP($JOB,"NURCEN"))
- WRITE !,"NO DATA FOR THIS REPORT"
- GOTO Q1
- +8 IF NUREDB="P"
- SET NPWARD=$SELECT($DATA(^NURSF(214,DFN,0)):$PIECE(^(0),"^",3),1:"")
- IF NPWARD'=""
- DO EN6^NURSAUTL
- +9 if NPWARD'=""
- SET GMRVWLO=NPWARD
- +10 SET GMRDATE=NURSTRT_"^"_NURFIN_"^"_NGRAPH
- SET NURRM=""
- +11 FOR
- SET NURRM=$ORDER(^TMP($JOB,"NURCEN",NURRM))
- if NURRM=""!NURQUIT
- QUIT
- SET NBED=""
- FOR
- SET NBED=$ORDER(^TMP($JOB,"NURCEN",NURRM,NBED))
- if NBED=""!NURQUIT
- QUIT
- SET NURNAM=""
- FOR
- SET NURNAM=$ORDER(^TMP($JOB,"NURCEN",NURRM,NBED,NURNAM))
- if NURNAM=""!NURQUIT
- QUIT
- DO REPT
- +12 GOTO Q1
- REPT ;
- +1 if '$DATA(^TMP($JOB,"NURCEN",NURRM,NBED,NURNAM))
- QUIT
- SET DFN=+$PIECE(^(NURNAM),"^")
- if DFN>0
- DO EN5^GMRVSR0
- +2 QUIT
- DATE SET %DT("A")="Start DATE (TIME optional): "
- SET %DT("B")="T-7"
- SET %DT="AETX"
- DO ^%DT
- KILL %DT
- IF +Y'>0
- SET NURQUIT=1
- QUIT
- +1 SET NURSTRT=+Y
- +2 SET %DT("A")="Go to DATE (TIME optional): "
- SET %DT="AETX"
- SET %DT("B")="NOW"
- DO ^%DT
- KILL %DT
- IF +Y'>0
- SET NURQUIT=1
- QUIT
- +3 IF $PIECE(Y,".",2)'>0
- IF Y=DT
- DO NOW^%DTC
- SET Y=%
- +4 IF $PIECE(Y,".",2)'>0
- SET Y=Y_$SELECT(Y[".":"2400",1:".2400")
- +5 SET (X1,NURFIN)=+Y
- SET X2=NURSTRT
- DO ^%DTC
- +6 IF X<0!(X=0&(((+("."_$PIECE(NURFIN,".",2))*10000)-((+("."_$PIECE(NURSTRT,".",2))*10000)))'>0))
- WRITE !?5,"Ending date of range needs to be greater that starting date.",!?5,$CHAR(7),"PLEASE REENTER!!"
- GOTO DATE
- +7 SET Y=NURSTRT
- XECUTE ^DD("DD")
- SET GSTRFIN=Y
- SET Y=NURFIN
- XECUTE ^DD("DD")
- SET GSTRFIN=GSTRFIN_" - "_Y
- +8 QUIT
- Q1 DO Q2^GMRVSR0
- Q2 KILL NURLOCSW,NGRAPH,NURP,ZTSK,ZTDESC,X1,X2
- DO ^%ZISC
- +1 KILL ^TMP($JOB),DFN,GMRDATE,NAME,NBED,NI,NN,NROOM,NURRM,NRMBD,NURNAM,GMRDT,NIEF,NWRD,NURFIN,NURSTRT,NUR5FLG,NUREDB,NPWARD,NURWARD,X,Y,GMROUT,NURQUIT,NORM,NUREDB,GMRVWLO,G,ND1,NDA,NURQUEUE,NURI,NURLEN,NURRMST,NURPERR
- +2 KILL NURSX,NURSY,NURX,NWLOC,%W,%T,%Y1,VAROOT
- +3 KILL NURMDSW,GSTRFIN
- QUIT
- EN2 ;VITAL SIGNS DISPLAY BY INDIVIDUAL PATIENT
- +1 ;ENTRY POINT FOR OPTION NURCPP-VIT-DISP
- +2 DO EN2^GMRVDS0
- +3 QUIT
- EN3 ;REPORT OF VITALS ENTERED IN ERROR FOR A PATIENT
- +1 ;ENTRY POINT FOR OPTION NURCPP-VIT-ERROR
- +2 DO EN1^GMRVER0
- +3 QUIT
- EN4 ;CUMULATIVE VITALS REPORT BY WARD/ROOM/PATIENT
- +1 ;ENTRY POINT FOR OPTION NURCPP-VIT-CUM
- +2 SET NURQUIT=0
- DO ^NURCVUT0
- if NURQUIT!(NUREDB["S"&'$DATA(NRMBD))
- GOTO Q4
- +3 KILL ^TMP($JOB,"NURCEN")
- DO ^NURCAS2
- IF '$DATA(^TMP($JOB,"NURCEN"))
- WRITE !,"NO PATIENT FOR THIS REPORT"
- GOTO Q4
- +4 SET GMRX=""
- SET GMROUT=0
- IF "Pp"[NUREDB
- DO INP^VADPT
- if VAIN(7)'=""
- SET GMRX=$PIECE($PIECE(VAIN(7),"^",2),"@")
- +5 DO DATE^GMRVSC0
- if GMROUT
- GOTO Q4
- SET ZTRTN="START4^NURCVPR0"
- FOR G="GMRVSDT","GMRVFDT","DFN","^TMP($J,","NUREDB","GMROUT"
- SET ZTSAVE(G)=""
- +6 DO EN7^NURSUT0
- IF POP!($DATA(ZTSK))
- GOTO Q4
- START4 SET GMRPG=0
- USE IO
- +1 SET NURRM=""
- +2 FOR
- SET NURRM=$ORDER(^TMP($JOB,"NURCEN",NURRM))
- if NURRM=""!($GET(GMROUT))
- QUIT
- SET NBED=""
- FOR
- SET NBED=$ORDER(^TMP($JOB,"NURCEN",NURRM,NBED))
- if NBED=""!($GET(GMROUT))
- QUIT
- SET NURNAM=""
- FOR
- SET NURNAM=$ORDER(^TMP($JOB,"NURCEN",NURRM,NBED,NURNAM))
- if NURNAM=""!($GET(GMROUT))
- QUIT
- DO REPORT
- Q4 DO Q2
- DO KVAR^VADPT
- KILL GFLAG,GMROUT,GMRPG,GMRVSDT,GMRVFDT,GMRX,VA
- QUIT
- REPORT SET DFN=+$PIECE(^TMP($JOB,"NURCEN",NURRM,NBED,NURNAM),"^")
- if DFN>0
- DO EN5^GMRVSC0
- +1 QUIT
- EN5 ;DISPLAY VITAL SIGNS BY LOCATION
- +1 ;ENTRY POINT FOR NURCPP-VIT-WARD
- +2 ; LOOKUP FILE 211.4 TO GET NURSING LOCATION
- +3 ;OUTPUT VARIABLES: ^TMP($J,ROOM-BED,PATIENT NAME,DFN)=""
- +4 ; DFN = POINTER TO FILE 2
- +5 ; GMRVWLO = NURSING LOCATION
- +6 ;EN3^GMRVSL0 IS CALLED TO PRINT VITALS FOR THE PATIENTS IN ^TMP($J)
- +7 SET (NURLOCSW,NURQUIT)=0
- SET NUREDB="U"
- DO WARDSEL^NURCUT0
- IF NURQUIT
- GOTO Q2
- +8 IF '$DATA(^NURSF(211.4,+$GET(NURWARD),3,0))!($ORDER(^(0))'>0)
- WRITE !,"**** NO DATA FOR UNIT : ",NPWARD
- GOTO Q2
- +9 SET ZTRTN="START2^NURCVPR0"
- SET ZTDESC="Unit Vital/Measurements Report"
- FOR G="NURQUIT","NURWARD","NPWARD"
- SET ZTSAVE(G)=""
- +10 DO EN7^NURSUT0
- if POP!($DATA(ZTSK))
- GOTO Q2
- START2 ;
- +1 FOR DFN=0:0
- SET DFN=$ORDER(^NURSF(214,"AF","A",NURWARD,DFN))
- if DFN'>0
- QUIT
- DO 1^VADPT
- SET ^TMP($JOB,$SELECT(VAIN(5)'="":VAIN(5),1:" BLANK"),$SELECT(VADM(1)'="":VADM(1),1:" BLANK"),DFN)=""
- +2 SET GMRVWLO=NPWARD
- SET GMRVHLOC=$PIECE($GET(^DIC(42,+$GET(VAIN(4)),44)),"^")
- DO EN3^GMRVDS1
- +3 GOTO Q2