PSIVARH ;AAC/JLS - DISPLAY RECENTLY DC'D IV ORDERS ; 17 Nov 2015 1:53 PM
;;5.0;INPATIENT MEDICATIONS;**325**;;Build 37
;
EN101(PSIVMSG) ;Entry from protocol PSIVARH PHARMACY
;
N ORIFN,PSJORD,ORVP
D DECODE^PSIVARH1
I $G(PSIVPKG(2),"")="" Q
I PSIVPKG(2)'["PHARMACY" Q
I ";DC;XO;"'[(";"_$G(PSIVSTS)_";") Q
;
I PSIVSTS="DC" D
. S ORIFN=+PSIVIFNF
. S PSJORD=$P(PSIVIFNP,U,1)
. I PSJORD'["V" Q ;only IV
. S ORVP=DFN
. D STORE1(ORIFN,PSJORD,ORVP)
;
I PSIVSTS="XO" D
. I PSIVIFNP'="" Q ;placer # exists so this is not a dc/edit
. S ORIFN=$$GET1^DIQ(100,+PSIVIFNF,9,"I") ;prior orifn
. I 'ORIFN Q
. S PSIVSTS0=$$GET1^DIQ(100,+ORIFN,5,"I") ;prior status
. I PSIVSTS0'=12 Q ;only dc/edit
. S PSJORD=$$GET1^DIQ(100,+ORIFN,33,"I") ;prior pkg ref
. I PSJORD'["V" Q ;ONLY IV
. S ORVP=DFN
. D STORE1(ORIFN,PSJORD,ORVP)
K PSIV42,PSIV44,PSIVDUZ,PSIVEDT,PSIVFLD,PSIVIFNF,PSIVIFNP,PSIVLOC,PSIVMSG,PSIVPKG,PSIVRDT
K PSIVRDUZ,PSIVRM,PSIVSTS,PSIVSTS0
Q
STORE1(ORIFN,PSJORD,ORVP) ;Get common info
;;ORVP
N QNOW,LOCIEN,LOCNAME,WRDIEN,WG,PSIVF,PHORD,X,Y,%
S QNOW=$$NOW^XLFDT
S LOCIEN=$P($G(^OR(100,+ORIFN,0)),U,10) ; p44
S LOCNAME=$P($G(^SC(+LOCIEN,0)),"^",1) ;name
I LOCNAME="" S LOCNAME="NO WARD"
Q:'LOCIEN
S WRDIEN=$P($G(^SC(+LOCIEN,42)),U)
S WG=0
S:+WRDIEN WG=$O(^PS(57.5,"AB",WRDIEN,WG))
S PHORD=$$OI(+ORIFN) ;;ORDER NUMBER
I PSJORD["P" S PSIVF=$NA(^PS(53.1,+PSJORD))
E S PSIVF=$NA(^PS(55,+ORVP,$S(PSJORD["V":"IV",1:5),+PSJORD))
;STORE IF AN IV ORDER AND THE PARAMETER NOT SET TO 0 (FEATURE TURNED OFF)
I $$IVROFF(ORVP,PSJORD)'=0 D STOREIV
Q
IVROFF(ORVP,PSJORD) ;
;FUNCTION RETURNS IVROOM'S DC'D ORDERS SETTING
N IVR,IVHRS
S IVR=$$IVROOM(ORVP,+PSJORD)
S IVHRS=$P($$GETHRS^PSIVARH1($P(IVR,U,1)),U,3)
Q IVHRS
;
OI(Q) ;Get pharmacy orderable item
N QQ,PHORD,PSIVOI,PSIVOID
S QQ=0,PHORD=0
F S QQ=$O(^OR(100,Q,.1,QQ)) Q:'QQ D
. S PSIVOI=$P(^OR(100,Q,.1,QQ,0),U)
. S PSIVOID=$P(^ORD(101.43,PSIVOI,0),U,2)
. I PSIVOID'["PSP" Q
. S PHORD=$P(PSIVOID,";")
Q PHORD
STOREIV ;Store IV info
N PSIVMR,PSIVSCH,PSIVDO,DIC,DD,DO,X,Y,%
S PSIVMR=$P($G(@PSIVF@(.2)),U,3)
S PSIVMR=$$GET1^DIQ(51.2,PSIVMR,1) ;abbrev
I PSIVMR="" S PSIVMR=$$GET1^DIQ(51.2,PSIVMR,.01) ;long name
S PSIVMR=$E(PSIVMR,1,5)
S PSIVSCH=$P($G(@PSIVF@(0)),U,8)
I +LOCIEN D
.K DIC S DIC="^PS(52.75,",DIC(0)="LQ",X=QNOW
.S DIC("DR")="2////"_+ORVP_";3////"_PHORD_";4////"_$G(^DPT(+ORVP,.101),9999)_";5////"_LOCNAME_";7////"_+LOCIEN_";8////"_PSJORD_";9////"_WG_";10////"_$G(PSIVSTS)
.S DIC("DR")=DIC("DR")_";.662////"_"Give: "_PSIVMR_" "_$TR(PSIVSCH,";",",")
.D FILE^DICN
.K DD,DO
Q
;
;==========================================================
;
START ;Called from PSGVBW to display orders; Input: PSGSS,WD,WG
Q:'$D(PSGSS)!("^G^W^"'[(U_$G(PSGSS)_U))
N PSIVDA,PSIVRI,PSIVWG,PSIVWDI,PSIVWN,WRDIEN,WDSETUP,GRSETUP
N PSIVXREF,DIC,DR,DIR,WARD,X,HRSFILT,TDNODE,TPNODE
;
;
; global to determine if the user elected to queue the print
; if so we don't touch ^TMP( that holds the data that will print
;
; global to note the IV room the user is signed into.
; this is used to screen out orders from the report that
; are associated with other IV rooms
;
N SIGNONIV
S SIGNONIV=+$G(^TMP("PSJUSER",$J,"PSIV","PSIVSN"))
S SIGNONIV=SIGNONIV_U_$P($G(^PS(59.5,SIGNONIV,0)),U)
;
;
N ZTSK,RPTITLE,RPTITLE1,RPTITLE2
S RPTITLE="IV ORDER D/Cs and EDITS Thru CPRS"
;
; get the iv room parameter for how far back
; to look at IV orders (# of hours--integer)
;
S HRSFILT=$$GETHRS^PSIVARH1(PSIVSN)
;
; don't display the report if HOURS FILTER parameter
; is set to zero.
;
Q:$P(HRSFILT,U,3)=0
;
S RPTITLE1=RPTITLE_" Since "_$$FMTE^XLFDT($P(HRSFILT,U,1),"5M")_" (past "_$P(HRSFILT,U,3)_" hrs)"
;
;
; display DC'd or Edited orders within HRSFILT
;
S (GRSETUP,WDSETUP)=0
;
;if group or ward selected initialize selection specific vars and check for data
; quit if there is no data
;
S:PSGSS="G" GRSETUP=$$GRSETUP(WG)
Q:GRSETUP<0
;
S:PSGSS="W" WDSETUP=$$WDSETUP(WD)
Q:WDSETUP<0
;
; continue display and action loop until user wants to quit
D ORDLOOP
D EXIT
Q
ORDLOOP ; Loop through orders for each ward or each ward in a group
;
; PAUSE is set to true if the user up arrowed during the display
; so they can be prompted to take action on records that they have
; viewed so far
;
N ACTION,PAUSE,PSIVQT,NORECS
S (NORECS,PAUSE)=0,PSIVQT=""
F D Q:($G(PSIVQT)=1)!(PAUSE)!(NORECS)
.
.; global counts records that displayed (DISP subroutine)
.; from the signon IV room. If none then give user a message.
.;
.N RECCNT S RECCNT=0
.;
.; Node setup for ^TMP arrays to hold data to be printed or deleted
.; Print array needs to be unique ($H) for case where user queues print
.; and same user then could review or delete entries included in queued print job.
.;
. I $D(TDNODE) D TMPCLEAN^PSIVARH1(TDNODE)
. S TDNODE="PSI52.75 DELETE"
. I $D(TPNODE) D TMPCLEAN^PSIVARH1(TPNODE)
. S TPNODE="PSI52.75 PRINT"_" "_$P($H,",")_$P($H,",",2)
.;
. N PSIVLN
. D HEADER(.PSIVLN)
. D:PSGSS="G" GLOOP
. D:PSGSS="W" WLOOP(WRDIEN)
. I RECCNT=0 D Q
.. D NODCD^PSIVARH1("IV room "_$P(SIGNONIV,U,2),$P(HRSFILT,U,3))
.. N X S X=$$ASK(1)
.. S NORECS=1
. Q:PAUSE
. S ACTION=$$ACTION^PSIVARH1()
.;
. Q:"R"[ACTION
. I "P"[ACTION D PRINT Q
. I "D"[ACTION I $$YOURSURE^PSIVARH1() D DELETE(TDNODE) Q
. I "I^"[ACTION S PSIVQT=1 Q
;
Q
GRSETUP(WG) ; setup vars for group and return -1 if no data
;
N RETURN,WGRPNM
S RETURN=0
S WGRPNM=$P($G(^PS(57.5,$G(WG),0)),U)
;
;quit if the data check reveals that there are no records within the last HRSFILT
;
I '$$ISDATAG^PSIVARH1(WG) D Q RETURN
. D NODCD^PSIVARH1("ward group "_WGRPNM,$P(HRSFILT,U,3)) S HOLD=$$ASK(1)
. S RETURN=-1
;
S PSIVWG=WG
S RPTITLE2="IV ROOM: "_$P(SIGNONIV,U,2)_" GROUP: "_$P(^PS(57.5,PSIVWG,0),U)
Q RETURN
WDSETUP(WD) ;
N RETURN
S RETURN=0
S WARD=$P($G(^DIC(42,WD,0)),U)
;
; find ward ien its a pointer from file 42
S WRDIEN=+$G(^DIC(42,WD,44))
;
I '$$ISDATAW^PSIVARH1(WRDIEN) D Q RETURN
. D NODCD^PSIVARH1("ward "_WARD,$P(HRSFILT,U,3))
. S HOLD=$$ASK(1)
. S RETURN=-1
S RPTITLE2="IV ROOM: "_$P(SIGNONIV,U,2)_" WARD: "_WARD
Q RETURN
;
GLOOP ;Loop through each ward in the group to display records.
;
N WARD,VWDI
;
S VWDI=0
F S VWDI=$O(^PS(57.5,WG,1,"B",VWDI)) Q:'VWDI!PSIVQT D
. S WRDIEN=+$G(^DIC(42,VWDI,44))
. I $G(WRDIEN)>0 D
.. S WARD=$P($G(^SC(+WRDIEN,0)),U)
.. D WLOOP(WRDIEN)
Q
WLOOP(WRDIEN) ;
;ADDED AW NEW COMPOUND INDEX EG
; ^PS(52.75,"AW","C MEDICINE",3160510.11443,5)=""
; WARD ROOM DT IEN
N PSIVDA,THISHR
S THISHR=$P(HRSFILT,U,1)
F S THISHR=$O(^PS(52.75,"AW",WRDIEN,THISHR)) Q:'THISHR!PSIVQT D
.S PSIVDA=""
.F S PSIVDA=$O(^PS(52.75,"AW",WRDIEN,THISHR,PSIVDA)) Q:'PSIVDA!PSIVQT D
..; quit if the data is not there
.. Q:'$D(^PS(52.75,PSIVDA,0))
.. D DISP(.PSIVLN)
.. D PAUSE(.PSIVLN)
Q
DISP(PSIVLN) ;Display data
N PSIVND,PSIVDT,PSIVPN,PSIVPID,PSIVDRN,PSIVRB,PSIVWN,PSIVSIG
N PSIVSS,INTDCDT,ORDERNUM
S PSIVND=^PS(52.75,PSIVDA,0)
S INTDCDT=$P(PSIVND,U) ; fileman internal discontinue/edit date/time
S PSIVDT=$$FMTE^XLFDT($P(PSIVND,U),"5MZP")
N PSIDT,PSITM
;
S PSIDT=$P(PSIVDT," ",1)
S PSITM=$P(PSIVDT," ",2,3)
S PSIVPN=$P(PSIVND,U,2)
S PSIVPID=$E($P($G(^DPT(PSIVPN,0)),U,9),6,9)
S PSIPNAME=$P($G(^DPT(PSIVPN,0)),U)
S PSIVDRN=$P(PSIVND,U,3)
S PSIVSS=$P(PSIVND,U,10)
S PSIVRB=$P(PSIVND,U,4)
S PSIVSIG=$G(^PS(52.75,PSIVDA,.662))
;
; look for IV Room for this order and exclude if not current IV Room
;
N IVROOM,ROOMIEN
S ORDERNUM=+$P(PSIVND,U,8)
S IVROOM=$$IVROOM(PSIVPN,ORDERNUM)
S ROOMIEN=+IVROOM
Q:(+SIGNONIV'=ROOMIEN)
;
; count the records that match current IV room. In case there are
; none RECORD=0, then don't display action prompt and give user
; message that there aren't any records for the signed on IV Room
;
S RECCNT=RECCNT+1
;
;count display lines for pagination
;
S PSIVLN=PSIVLN+2
;
; display the data and save a ^TMP version of entries to Print and entries to delete.
;
D DISPLINE(WARD,PSIVRB,PSIVDRN,PSIPNAME,PSIVPID,PSIDT,PSIVSIG,PSITM,PSIVSS)
D SAVELINE(WRDIEN,WARD,PSIVRB,PSIVDRN,PSIPNAME,PSIVPID,PSIDT,PSIVSIG,PSITM,THISHR,PSIVDA,PSIVSS)
;
Q
;
IVROOM(PHPTIEN,ORDERNUM) ;
; return IV Room for this dc or edit order
; returns 2 piece--IEN of IV Room ^ display name of IV room
;
N IVROOMEX,IVRMIEN
S (IVROOMEX,IVRMIEN)=""
I $G(PHPTIEN)>0&($G(ORDERNUM)>0) S IVRMIEN=$P($G(^PS(55,PHPTIEN,"IV",ORDERNUM,2)),U,2)
I IVRMIEN>0 S IVROOMEX=$P($G(^PS(59.5,IVRMIEN,0)),U)
Q IVRMIEN_U_IVROOMEX
;
DISPLINE(WARD,PSIVRB,PSIVDRN,PSIPNAME,PSIVPID,PSIDT,PSIVSIG,PSITM,PSIVSS) ;
;Display a single line of the data
;
W !?1,$E(WARD,1,9) ; ward name
W ?12,$E(PSIVRB,1,8) ; room-bed
I $G(PSIVDRN)>0 W ?21,$E($P(^PS(50.7,PSIVDRN,0),U),1,18)
W ?42,$E(PSIPNAME,1,15) ; patient name
W ?59,PSIVPID ; patient L4
W ?64,PSIDT ; date/time .01
S PSIVSS=$S(PSIVSS="XO":"Edited",PSIVSS="DC":"Discontinued",1:"")
W !?3,$G(PSIVSS),?22,$E(PSIVSIG,1,42),?65,"@",PSITM
Q
;
;
SAVELINE(WRDIEN,WARD,PSIVRB,PSIVDRN,PSIPNAME,PSIVPID,PSIDT,PSIVSIG,PSITM,THISHR,PSIVDA,PSIVSTS) ;
;save last displayed record in case we need to protect remaining records from deletion
;
S ^TMP(TDNODE,$J,WRDIEN,THISHR,PSIVDA)=""
;
S ^TMP(TPNODE,$J,WRDIEN,THISHR,PSIVDA)=WARD_U_PSIVRB_U_PSIVDRN_U_PSIPNAME_U_PSIVPID_U_PSIDT_U_PSIVSIG_U_PSITM_U_PSIVSTS
Q
;
PRINT ;
;
N PFLAGDEL ; flag based on users response to whether they want to delete or retain after printing
S PFLAGDEL=$$PFLAGDEL() Q:PFLAGDEL<0
;
N HOLD W !!,"Only data that you have viewed will be printed." S HOLD=$$ASK(1)
N %ZIS,POP,IOP
S %ZIS="MQ"
D ^%ZIS
Q:POP
I $D(IO("Q")) D
. K IO("Q")
. N ZTDESC,ZTRTN,ZTSAVE
. S ZTDESC=RPTITLE1_"-"_RPTITLE2
. S ZTRTN="PRINT1^PSIVARH"
. S ZTSAVE("^TMP(TPNODE,$J,")=""
. S ZTSAVE("TPNODE")=""
. S ZTSAVE("RPTITLE1")=""
. S ZTSAVE("RPTITLE2")=""
. D ^%ZTLOAD
. I $D(ZTSK) D
.. S ZTREQ="@"
.. W !,"Your task number is ",ZTSK," and it has been queued."
. E D
.. W !,"Your task was NOT queued."
E D
. U IO
. D PRINT1
D ^%ZISC K %ZIS,IOP
S HOLD=$$ASK(1)
I PFLAGDEL D DELETE(TDNODE)
Q
;
PRINT1 ;
;
;print records that were viewed and stored in the TMP global
;
; S ^TMP("PSI DEL ENTRIES 52.75",1756,77,3160512.143021,9)=
; => "C MEDICINE^9999^2032^AAADTSXY,QLYJH U^M^2470203^E^2^^PASTOR
; => ^25^101074507^RCD RCVD FM ROSEBURG OR, 072790-JWR^WOLVINGTON
; => ^27^^3^331^2900712^^^^1^4507^05/12/2016^Give: IV 4 ml/hr^2:30 pm"
;
N WDIEN,ODATA,WARD,PSIVRB,PSIVDRN,PSIPNAME,PSIVPID,PSIDT,PSIVSIG,PSITM,LCNT,PSIVSS
S LCNT=0
D HEADER(.LCNT)
;
S (PSIVQT,WDIEN)=0
F S WDIEN=$O(^TMP(TPNODE,$J,WDIEN)) Q:(WDIEN'>0)!PSIVQT D
. S ODT=0
. F S ODT=$O(^TMP(TPNODE,$J,WDIEN,ODT)) Q:(ODT'>0)!PSIVQT D
.. S OIEN=0
.. F S OIEN=$O(^TMP(TPNODE,$J,WDIEN,ODT,OIEN)) Q:(OIEN'>0)!PSIVQT D
... I OIEN>0 D
.... S ODATA=$G(^TMP(TPNODE,$J,WDIEN,ODT,OIEN))
.... S WARD=$P(ODATA,U)
.... S PSIVRB=$P(ODATA,U,2)
.... S PSIVDRN=$P(ODATA,U,3)
.... S PSIPNAME=$P(ODATA,U,4)
.... S PSIVPID=$P(ODATA,U,5)
.... S PSIDT=$P(ODATA,U,6)
.... S PSIVSIG=$P(ODATA,U,7)
.... S PSITM=$P(ODATA,U,8)
.... S PSIVSS=$P(ODATA,U,9)
.... D DISPLINE(WARD,PSIVRB,PSIVDRN,PSIPNAME,PSIVPID,PSIDT,PSIVSIG,PSITM,PSIVSS)
.... S LCNT=LCNT+2
.... D PAUSE(.LCNT)
W !,"END OF REPORT.",!
;
;clean up print node if the print job was queued
;
D:$D(ZTSK) TMPCLEAN^PSIVARH1(TPNODE)
Q
;
PFLAGDEL() ; ask user whether to delete after printing.
N DIR,DUOUT,DTOUT,DIROUT,DIRUT,X,Y
S DIR("B")="N"
S DIR(0)="Y",DIR("A")="Do you also want to delete the records that you are printing"
S DIR("?")="Answer yes to remove the discontinued orders tracking entries after printing."
S DIR("?",1)="The records you have viewed are from a temporary tracking file"
S DIR("?",2)="and they can be deleted without any impact to the orders file."
D ^DIR
I $D(DIRUT) Q -1
Q Y
;
DELETE(NODE) ;
;
N DIK,WDIEN,ODT,OIEN,DA,HOLD
S DIK="^PS(52.75,"
S WDIEN=0
F S WDIEN=$O(^TMP(NODE,$J,WDIEN)) Q:(WDIEN'>0)!PSIVQT D
. S ODT=0
. F S ODT=$O(^TMP(NODE,$J,WDIEN,ODT)) Q:(ODT'>0)!PSIVQT D
.. S OIEN=0
.. F S OIEN=$O(^TMP(NODE,$J,WDIEN,ODT,OIEN)) Q:OIEN'>0 D
... S DA=OIEN D ^DIK
... I $E(IOST,1,2)="C-" W "."
I $E(IOST,1,2)="C-" D
. W !," Records which you have viewed or printed from"
. W !," the temporary file--IV MEDICATION ORDERS DC'D (#52.75)"
. W !," have been removed."
. S HOLD=$$ASK(1)
Q
N PSIVI
S $P(PSIVI,"-",80)=""
S PSIVLN=4
W @IOF,!,?(IOM-$L(RPTITLE1))\2,RPTITLE1
W !,?(IOM-$L(RPTITLE2))\2,RPTITLE2
W !?1,"WARD - ROOM/BED",?22,"DRUG",?42,"PATIENT",?59,"PID",?65,"DT/TM",!,PSIVI,!
Q
;
ASK(HOLD) ;ask user 2 continue function
;return true (1) if user want's 2 stop, false (0) 2 continue.
;If HOLD defined, use prompt 2 hold display until user hits return.
;If not terminal then, do nothing, return FALSE.
;
N STOP S STOP=0
I $E(IOST,1,2)="C-" D
.;
. N RESP,DIR S RESP=0
. I $G(HOLD) S DIR(0)="EA",DIR("A")="Enter return to continue. "
. E S DIR(0)="E"
. D ^DIR I Y="" S STOP=0
. I $D(DIRUT) S STOP=1
Q STOP
;
PAUSE(PSIVLN) ;Btw screens
;not to bottom of page yet so don't do anything
Q:'(($G(PSIVLN)+4)>$G(IOSL))
;
I $E(IOST,1,2)="C-" D
. S PSIVQT=$$ASK()
Q:PSIVQT
D HEADER(.PSIVLN)
Q
;
TURNOFF(VALUE) ;entry point called from IV room Input transform field 21
;
Q:$G(VALUE)>0 0
N SURE,Y,X
S SURE=$$SURE^PSIVARH1()
I SURE D CLEAN^PSIVARH1
Q 'SURE
;
EXIT D ^%ZISC
K PSIVRM,PSIVWD,WARD
;
; user can print, delete, or print and delete. if the print is queued,
; then the print logic cleans up TMP, otherwise we need to clean it up
; now.
;
D TMPCLEAN^PSIVARH1(TDNODE)
D TMPCLEAN^PSIVARH1(TPNODE)
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSIVARH 17035 printed Dec 13, 2024@02:03:53 Page 2
PSIVARH ;AAC/JLS - DISPLAY RECENTLY DC'D IV ORDERS ; 17 Nov 2015 1:53 PM
+1 ;;5.0;INPATIENT MEDICATIONS;**325**;;Build 37
+2 ;
EN101(PSIVMSG) ;Entry from protocol PSIVARH PHARMACY
+1 ;
+2 NEW ORIFN,PSJORD,ORVP
+3 DO DECODE^PSIVARH1
+4 IF $GET(PSIVPKG(2),"")=""
QUIT
+5 IF PSIVPKG(2)'["PHARMACY"
QUIT
+6 IF ";DC;XO;"'[(";"_$GET(PSIVSTS)_";")
QUIT
+7 ;
+8 IF PSIVSTS="DC"
Begin DoDot:1
+9 SET ORIFN=+PSIVIFNF
+10 SET PSJORD=$PIECE(PSIVIFNP,U,1)
+11 ;only IV
IF PSJORD'["V"
QUIT
+12 SET ORVP=DFN
+13 DO STORE1(ORIFN,PSJORD,ORVP)
End DoDot:1
+14 ;
+15 IF PSIVSTS="XO"
Begin DoDot:1
+16 ;placer # exists so this is not a dc/edit
IF PSIVIFNP'=""
QUIT
+17 ;prior orifn
SET ORIFN=$$GET1^DIQ(100,+PSIVIFNF,9,"I")
+18 IF 'ORIFN
QUIT
+19 ;prior status
SET PSIVSTS0=$$GET1^DIQ(100,+ORIFN,5,"I")
+20 ;only dc/edit
IF PSIVSTS0'=12
QUIT
+21 ;prior pkg ref
SET PSJORD=$$GET1^DIQ(100,+ORIFN,33,"I")
+22 ;ONLY IV
IF PSJORD'["V"
QUIT
+23 SET ORVP=DFN
+24 DO STORE1(ORIFN,PSJORD,ORVP)
End DoDot:1
+25 KILL PSIV42,PSIV44,PSIVDUZ,PSIVEDT,PSIVFLD,PSIVIFNF,PSIVIFNP,PSIVLOC,PSIVMSG,PSIVPKG,PSIVRDT
+26 KILL PSIVRDUZ,PSIVRM,PSIVSTS,PSIVSTS0
+27 QUIT
STORE1(ORIFN,PSJORD,ORVP) ;Get common info
+1 ;;ORVP
+2 NEW QNOW,LOCIEN,LOCNAME,WRDIEN,WG,PSIVF,PHORD,X,Y,%
+3 SET QNOW=$$NOW^XLFDT
+4 ; p44
SET LOCIEN=$PIECE($GET(^OR(100,+ORIFN,0)),U,10)
+5 ;name
SET LOCNAME=$PIECE($GET(^SC(+LOCIEN,0)),"^",1)
+6 IF LOCNAME=""
SET LOCNAME="NO WARD"
+7 if 'LOCIEN
QUIT
+8 SET WRDIEN=$PIECE($GET(^SC(+LOCIEN,42)),U)
+9 SET WG=0
+10 if +WRDIEN
SET WG=$ORDER(^PS(57.5,"AB",WRDIEN,WG))
+11 ;;ORDER NUMBER
SET PHORD=$$OI(+ORIFN)
+12 IF PSJORD["P"
SET PSIVF=$NAME(^PS(53.1,+PSJORD))
+13 IF '$TEST
SET PSIVF=$NAME(^PS(55,+ORVP,$SELECT(PSJORD["V":"IV",1:5),+PSJORD))
+14 ;STORE IF AN IV ORDER AND THE PARAMETER NOT SET TO 0 (FEATURE TURNED OFF)
+15 IF $$IVROFF(ORVP,PSJORD)'=0
DO STOREIV
+16 QUIT
IVROFF(ORVP,PSJORD) ;
+1 ;FUNCTION RETURNS IVROOM'S DC'D ORDERS SETTING
+2 NEW IVR,IVHRS
+3 SET IVR=$$IVROOM(ORVP,+PSJORD)
+4 SET IVHRS=$PIECE($$GETHRS^PSIVARH1($PIECE(IVR,U,1)),U,3)
+5 QUIT IVHRS
+6 ;
OI(Q) ;Get pharmacy orderable item
+1 NEW QQ,PHORD,PSIVOI,PSIVOID
+2 SET QQ=0
SET PHORD=0
+3 FOR
SET QQ=$ORDER(^OR(100,Q,.1,QQ))
if 'QQ
QUIT
Begin DoDot:1
+4 SET PSIVOI=$PIECE(^OR(100,Q,.1,QQ,0),U)
+5 SET PSIVOID=$PIECE(^ORD(101.43,PSIVOI,0),U,2)
+6 IF PSIVOID'["PSP"
QUIT
+7 SET PHORD=$PIECE(PSIVOID,";")
End DoDot:1
+8 QUIT PHORD
STOREIV ;Store IV info
+1 NEW PSIVMR,PSIVSCH,PSIVDO,DIC,DD,DO,X,Y,%
+2 SET PSIVMR=$PIECE($GET(@PSIVF@(.2)),U,3)
+3 ;abbrev
SET PSIVMR=$$GET1^DIQ(51.2,PSIVMR,1)
+4 ;long name
IF PSIVMR=""
SET PSIVMR=$$GET1^DIQ(51.2,PSIVMR,.01)
+5 SET PSIVMR=$EXTRACT(PSIVMR,1,5)
+6 SET PSIVSCH=$PIECE($GET(@PSIVF@(0)),U,8)
+7 IF +LOCIEN
Begin DoDot:1
+8 KILL DIC
SET DIC="^PS(52.75,"
SET DIC(0)="LQ"
SET X=QNOW
+9 SET DIC("DR")="2////"_+ORVP_";3////"_PHORD_";4////"_$GET(^DPT(+ORVP,.101),9999)_";5////"_LOCNAME_";7////"_+LOCIEN_";8////"_PSJORD_";9////"_WG_";10////"_$GET(PSIVSTS)
+10 SET DIC("DR")=DIC("DR")_";.662////"_"Give: "_PSIVMR_" "_$TRANSLATE(PSIVSCH,";",",")
+11 DO FILE^DICN
+12 KILL DD,DO
End DoDot:1
+13 QUIT
+14 ;
+15 ;==========================================================
+16 ;
START ;Called from PSGVBW to display orders; Input: PSGSS,WD,WG
+1 if '$DATA(PSGSS)!("^G^W^"'[(U_$GET(PSGSS)_U))
QUIT
+2 NEW PSIVDA,PSIVRI,PSIVWG,PSIVWDI,PSIVWN,WRDIEN,WDSETUP,GRSETUP
+3 NEW PSIVXREF,DIC,DR,DIR,WARD,X,HRSFILT,TDNODE,TPNODE
+4 ;
+5 ;
+6 ; global to determine if the user elected to queue the print
+7 ; if so we don't touch ^TMP( that holds the data that will print
+8 ;
+9 ; global to note the IV room the user is signed into.
+10 ; this is used to screen out orders from the report that
+11 ; are associated with other IV rooms
+12 ;
+13 NEW SIGNONIV
+14 SET SIGNONIV=+$GET(^TMP("PSJUSER",$JOB,"PSIV","PSIVSN"))
+15 SET SIGNONIV=SIGNONIV_U_$PIECE($GET(^PS(59.5,SIGNONIV,0)),U)
+16 ;
+17 ;
+18 NEW ZTSK,RPTITLE,RPTITLE1,RPTITLE2
+19 SET RPTITLE="IV ORDER D/Cs and EDITS Thru CPRS"
+20 ;
+21 ; get the iv room parameter for how far back
+22 ; to look at IV orders (# of hours--integer)
+23 ;
+24 SET HRSFILT=$$GETHRS^PSIVARH1(PSIVSN)
+25 ;
+26 ; don't display the report if HOURS FILTER parameter
+27 ; is set to zero.
+28 ;
+29 if $PIECE(HRSFILT,U,3)=0
QUIT
+30 ;
+31 SET RPTITLE1=RPTITLE_" Since "_$$FMTE^XLFDT($PIECE(HRSFILT,U,1),"5M")_" (past "_$PIECE(HRSFILT,U,3)_" hrs)"
+32 ;
+33 ;
+34 ; display DC'd or Edited orders within HRSFILT
+35 ;
+36 SET (GRSETUP,WDSETUP)=0
+37 ;
+38 ;if group or ward selected initialize selection specific vars and check for data
+39 ; quit if there is no data
+40 ;
+41 if PSGSS="G"
SET GRSETUP=$$GRSETUP(WG)
+42 if GRSETUP<0
QUIT
+43 ;
+44 if PSGSS="W"
SET WDSETUP=$$WDSETUP(WD)
+45 if WDSETUP<0
QUIT
+46 ;
+47 ; continue display and action loop until user wants to quit
+48 DO ORDLOOP
+49 DO EXIT
+50 QUIT
ORDLOOP ; Loop through orders for each ward or each ward in a group
+1 ;
+2 ; PAUSE is set to true if the user up arrowed during the display
+3 ; so they can be prompted to take action on records that they have
+4 ; viewed so far
+5 ;
+6 NEW ACTION,PAUSE,PSIVQT,NORECS
+7 SET (NORECS,PAUSE)=0
SET PSIVQT=""
+8 FOR
Begin DoDot:1
+9 +10 ; global counts records that displayed (DISP subroutine)
+11 ; from the signon IV room. If none then give user a message.
+12 ;
+13 NEW RECCNT
SET RECCNT=0
+14 ;
+15 ; Node setup for ^TMP arrays to hold data to be printed or deleted
+16 ; Print array needs to be unique ($H) for case where user queues print
+17 ; and same user then could review or delete entries included in queued print job.
+18 ;
+19 IF $DATA(TDNODE)
DO TMPCLEAN^PSIVARH1(TDNODE)
+20 SET TDNODE="PSI52.75 DELETE"
+21 IF $DATA(TPNODE)
DO TMPCLEAN^PSIVARH1(TPNODE)
+22 SET TPNODE="PSI52.75 PRINT"_" "_$PIECE($HOROLOG,",")_$PIECE($HOROLOG,",",2)
+23 ;
+24 NEW PSIVLN
+25 DO HEADER(.PSIVLN)
+26 if PSGSS="G"
DO GLOOP
+27 if PSGSS="W"
DO WLOOP(WRDIEN)
+28 IF RECCNT=0
Begin DoDot:2
+29 DO NODCD^PSIVARH1("IV room "_$PIECE(SIGNONIV,U,2),$PIECE(HRSFILT,U,3))
+30 NEW X
SET X=$$ASK(1)
+31 SET NORECS=1
End DoDot:2
QUIT
+32 if PAUSE
QUIT
+33 SET ACTION=$$ACTION^PSIVARH1()
+34 ;
+35 if "R"[ACTION
QUIT
+36 IF "P"[ACTION
DO PRINT
QUIT
+37 IF "D"[ACTION
IF $$YOURSURE^PSIVARH1()
DO DELETE(TDNODE)
QUIT
+38 IF "I^"[ACTION
SET PSIVQT=1
QUIT
End DoDot:1
if ($GET(PSIVQT)=1)!(PAUSE)!(NORECS)
QUIT
+39 ;
+40 QUIT
GRSETUP(WG) ; setup vars for group and return -1 if no data
+1 ;
+2 NEW RETURN,WGRPNM
+3 SET RETURN=0
+4 SET WGRPNM=$PIECE($GET(^PS(57.5,$GET(WG),0)),U)
+5 ;
+6 ;quit if the data check reveals that there are no records within the last HRSFILT
+7 ;
+8 IF '$$ISDATAG^PSIVARH1(WG)
Begin DoDot:1
+9 DO NODCD^PSIVARH1("ward group "_WGRPNM,$PIECE(HRSFILT,U,3))
SET HOLD=$$ASK(1)
+10 SET RETURN=-1
End DoDot:1
QUIT RETURN
+11 ;
+12 SET PSIVWG=WG
+13 SET RPTITLE2="IV ROOM: "_$PIECE(SIGNONIV,U,2)_" GROUP: "_$PIECE(^PS(57.5,PSIVWG,0),U)
+14 QUIT RETURN
WDSETUP(WD) ;
+1 NEW RETURN
+2 SET RETURN=0
+3 SET WARD=$PIECE($GET(^DIC(42,WD,0)),U)
+4 ;
+5 ; find ward ien its a pointer from file 42
+6 SET WRDIEN=+$GET(^DIC(42,WD,44))
+7 ;
+8 IF '$$ISDATAW^PSIVARH1(WRDIEN)
Begin DoDot:1
+9 DO NODCD^PSIVARH1("ward "_WARD,$PIECE(HRSFILT,U,3))
+10 SET HOLD=$$ASK(1)
+11 SET RETURN=-1
End DoDot:1
QUIT RETURN
+12 SET RPTITLE2="IV ROOM: "_$PIECE(SIGNONIV,U,2)_" WARD: "_WARD
+13 QUIT RETURN
+14 ;
GLOOP ;Loop through each ward in the group to display records.
+1 ;
+2 NEW WARD,VWDI
+3 ;
+4 SET VWDI=0
+5 FOR
SET VWDI=$ORDER(^PS(57.5,WG,1,"B",VWDI))
if 'VWDI!PSIVQT
QUIT
Begin DoDot:1
+6 SET WRDIEN=+$GET(^DIC(42,VWDI,44))
+7 IF $GET(WRDIEN)>0
Begin DoDot:2
+8 SET WARD=$PIECE($GET(^SC(+WRDIEN,0)),U)
+9 DO WLOOP(WRDIEN)
End DoDot:2
End DoDot:1
+10 QUIT
WLOOP(WRDIEN) ;
+1 ;ADDED AW NEW COMPOUND INDEX EG
+2 ; ^PS(52.75,"AW","C MEDICINE",3160510.11443,5)=""
+3 ; WARD ROOM DT IEN
+4 NEW PSIVDA,THISHR
+5 SET THISHR=$PIECE(HRSFILT,U,1)
+6 FOR
SET THISHR=$ORDER(^PS(52.75,"AW",WRDIEN,THISHR))
if 'THISHR!PSIVQT
QUIT
Begin DoDot:1
+7 SET PSIVDA=""
+8 FOR
SET PSIVDA=$ORDER(^PS(52.75,"AW",WRDIEN,THISHR,PSIVDA))
if 'PSIVDA!PSIVQT
QUIT
Begin DoDot:2
+9 ; quit if the data is not there
+10 if '$DATA(^PS(52.75,PSIVDA,0))
QUIT
+11 DO DISP(.PSIVLN)
+12 DO PAUSE(.PSIVLN)
End DoDot:2
End DoDot:1
+13 QUIT
DISP(PSIVLN) ;Display data
+1 NEW PSIVND,PSIVDT,PSIVPN,PSIVPID,PSIVDRN,PSIVRB,PSIVWN,PSIVSIG
+2 NEW PSIVSS,INTDCDT,ORDERNUM
+3 SET PSIVND=^PS(52.75,PSIVDA,0)
+4 ; fileman internal discontinue/edit date/time
SET INTDCDT=$PIECE(PSIVND,U)
+5 SET PSIVDT=$$FMTE^XLFDT($PIECE(PSIVND,U),"5MZP")
+6 NEW PSIDT,PSITM
+7 ;
+8 SET PSIDT=$PIECE(PSIVDT," ",1)
+9 SET PSITM=$PIECE(PSIVDT," ",2,3)
+10 SET PSIVPN=$PIECE(PSIVND,U,2)
+11 SET PSIVPID=$EXTRACT($PIECE($GET(^DPT(PSIVPN,0)),U,9),6,9)
+12 SET PSIPNAME=$PIECE($GET(^DPT(PSIVPN,0)),U)
+13 SET PSIVDRN=$PIECE(PSIVND,U,3)
+14 SET PSIVSS=$PIECE(PSIVND,U,10)
+15 SET PSIVRB=$PIECE(PSIVND,U,4)
+16 SET PSIVSIG=$GET(^PS(52.75,PSIVDA,.662))
+17 ;
+18 ; look for IV Room for this order and exclude if not current IV Room
+19 ;
+20 NEW IVROOM,ROOMIEN
+21 SET ORDERNUM=+$PIECE(PSIVND,U,8)
+22 SET IVROOM=$$IVROOM(PSIVPN,ORDERNUM)
+23 SET ROOMIEN=+IVROOM
+24 if (+SIGNONIV'=ROOMIEN)
QUIT
+25 ;
+26 ; count the records that match current IV room. In case there are
+27 ; none RECORD=0, then don't display action prompt and give user
+28 ; message that there aren't any records for the signed on IV Room
+29 ;
+30 SET RECCNT=RECCNT+1
+31 ;
+32 ;count display lines for pagination
+33 ;
+34 SET PSIVLN=PSIVLN+2
+35 ;
+36 ; display the data and save a ^TMP version of entries to Print and entries to delete.
+37 ;
+38 DO DISPLINE(WARD,PSIVRB,PSIVDRN,PSIPNAME,PSIVPID,PSIDT,PSIVSIG,PSITM,PSIVSS)
+39 DO SAVELINE(WRDIEN,WARD,PSIVRB,PSIVDRN,PSIPNAME,PSIVPID,PSIDT,PSIVSIG,PSITM,THISHR,PSIVDA,PSIVSS)
+40 ;
+41 QUIT
+42 ;
IVROOM(PHPTIEN,ORDERNUM) ;
+1 ; return IV Room for this dc or edit order
+2 ; returns 2 piece--IEN of IV Room ^ display name of IV room
+3 ;
+4 NEW IVROOMEX,IVRMIEN
+5 SET (IVROOMEX,IVRMIEN)=""
+6 IF $GET(PHPTIEN)>0&($GET(ORDERNUM)>0)
SET IVRMIEN=$PIECE($GET(^PS(55,PHPTIEN,"IV",ORDERNUM,2)),U,2)
+7 IF IVRMIEN>0
SET IVROOMEX=$PIECE($GET(^PS(59.5,IVRMIEN,0)),U)
+8 QUIT IVRMIEN_U_IVROOMEX
+9 ;
DISPLINE(WARD,PSIVRB,PSIVDRN,PSIPNAME,PSIVPID,PSIDT,PSIVSIG,PSITM,PSIVSS) ;
+1 ;Display a single line of the data
+2 ;
+3 ; ward name
WRITE !?1,$EXTRACT(WARD,1,9)
+4 ; room-bed
WRITE ?12,$EXTRACT(PSIVRB,1,8)
+5 IF $GET(PSIVDRN)>0
WRITE ?21,$EXTRACT($PIECE(^PS(50.7,PSIVDRN,0),U),1,18)
+6 ; patient name
WRITE ?42,$EXTRACT(PSIPNAME,1,15)
+7 ; patient L4
WRITE ?59,PSIVPID
+8 ; date/time .01
WRITE ?64,PSIDT
+9 SET PSIVSS=$SELECT(PSIVSS="XO":"Edited",PSIVSS="DC":"Discontinued",1:"")
+10 WRITE !?3,$GET(PSIVSS),?22,$EXTRACT(PSIVSIG,1,42),?65,"@",PSITM
+11 QUIT
+12 ;
+13 ;
SAVELINE(WRDIEN,WARD,PSIVRB,PSIVDRN,PSIPNAME,PSIVPID,PSIDT,PSIVSIG,PSITM,THISHR,PSIVDA,PSIVSTS) ;
+1 ;save last displayed record in case we need to protect remaining records from deletion
+2 ;
+3 SET ^TMP(TDNODE,$JOB,WRDIEN,THISHR,PSIVDA)=""
+4 ;
+5 SET ^TMP(TPNODE,$JOB,WRDIEN,THISHR,PSIVDA)=WARD_U_PSIVRB_U_PSIVDRN_U_PSIPNAME_U_PSIVPID_U_PSIDT_U_PSIVSIG_U_PSITM_U_PSIVSTS
+6 QUIT
+7 ;
PRINT ;
+1 ;
+2 ; flag based on users response to whether they want to delete or retain after printing
NEW PFLAGDEL
+3 SET PFLAGDEL=$$PFLAGDEL()
if PFLAGDEL<0
QUIT
+4 ;
+5 NEW HOLD
WRITE !!,"Only data that you have viewed will be printed."
SET HOLD=$$ASK(1)
+6 NEW %ZIS,POP,IOP
+7 SET %ZIS="MQ"
+8 DO ^%ZIS
+9 if POP
QUIT
+10 IF $DATA(IO("Q"))
Begin DoDot:1
+11 KILL IO("Q")
+12 NEW ZTDESC,ZTRTN,ZTSAVE
+13 SET ZTDESC=RPTITLE1_"-"_RPTITLE2
+14 SET ZTRTN="PRINT1^PSIVARH"
+15 SET ZTSAVE("^TMP(TPNODE,$J,")=""
+16 SET ZTSAVE("TPNODE")=""
+17 SET ZTSAVE("RPTITLE1")=""
+18 SET ZTSAVE("RPTITLE2")=""
+19 DO ^%ZTLOAD
+20 IF $DATA(ZTSK)
Begin DoDot:2
+21 SET ZTREQ="@"
+22 WRITE !,"Your task number is ",ZTSK," and it has been queued."
End DoDot:2
+23 IF '$TEST
Begin DoDot:2
+24 WRITE !,"Your task was NOT queued."
End DoDot:2
End DoDot:1
+25 IF '$TEST
Begin DoDot:1
+26 USE IO
+27 DO PRINT1
End DoDot:1
+28 DO ^%ZISC
KILL %ZIS,IOP
+29 SET HOLD=$$ASK(1)
+30 IF PFLAGDEL
DO DELETE(TDNODE)
+31 QUIT
+32 ;
PRINT1 ;
+1 ;
+2 ;print records that were viewed and stored in the TMP global
+3 ;
+4 ; S ^TMP("PSI DEL ENTRIES 52.75",1756,77,3160512.143021,9)=
+5 ; => "C MEDICINE^9999^2032^AAADTSXY,QLYJH U^M^2470203^E^2^^PASTOR
+6 ; => ^25^101074507^RCD RCVD FM ROSEBURG OR, 072790-JWR^WOLVINGTON
+7 ; => ^27^^3^331^2900712^^^^1^4507^05/12/2016^Give: IV 4 ml/hr^2:30 pm"
+8 ;
+9 NEW WDIEN,ODATA,WARD,PSIVRB,PSIVDRN,PSIPNAME,PSIVPID,PSIDT,PSIVSIG,PSITM,LCNT,PSIVSS
+10 SET LCNT=0
+11 DO HEADER(.LCNT)
+12 ;
+13 SET (PSIVQT,WDIEN)=0
+14 FOR
SET WDIEN=$ORDER(^TMP(TPNODE,$JOB,WDIEN))
if (WDIEN'>0)!PSIVQT
QUIT
Begin DoDot:1
+15 SET ODT=0
+16 FOR
SET ODT=$ORDER(^TMP(TPNODE,$JOB,WDIEN,ODT))
if (ODT'>0)!PSIVQT
QUIT
Begin DoDot:2
+17 SET OIEN=0
+18 FOR
SET OIEN=$ORDER(^TMP(TPNODE,$JOB,WDIEN,ODT,OIEN))
if (OIEN'>0)!PSIVQT
QUIT
Begin DoDot:3
+19 IF OIEN>0
Begin DoDot:4
+20 SET ODATA=$GET(^TMP(TPNODE,$JOB,WDIEN,ODT,OIEN))
+21 SET WARD=$PIECE(ODATA,U)
+22 SET PSIVRB=$PIECE(ODATA,U,2)
+23 SET PSIVDRN=$PIECE(ODATA,U,3)
+24 SET PSIPNAME=$PIECE(ODATA,U,4)
+25 SET PSIVPID=$PIECE(ODATA,U,5)
+26 SET PSIDT=$PIECE(ODATA,U,6)
+27 SET PSIVSIG=$PIECE(ODATA,U,7)
+28 SET PSITM=$PIECE(ODATA,U,8)
+29 SET PSIVSS=$PIECE(ODATA,U,9)
+30 DO DISPLINE(WARD,PSIVRB,PSIVDRN,PSIPNAME,PSIVPID,PSIDT,PSIVSIG,PSITM,PSIVSS)
+31 SET LCNT=LCNT+2
+32 DO PAUSE(.LCNT)
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+33 WRITE !,"END OF REPORT.",!
+34 ;
+35 ;clean up print node if the print job was queued
+36 ;
+37 if $DATA(ZTSK)
DO TMPCLEAN^PSIVARH1(TPNODE)
+38 QUIT
+39 ;
PFLAGDEL() ; ask user whether to delete after printing.
+1 NEW DIR,DUOUT,DTOUT,DIROUT,DIRUT,X,Y
+2 SET DIR("B")="N"
+3 SET DIR(0)="Y"
SET DIR("A")="Do you also want to delete the records that you are printing"
+4 SET DIR("?")="Answer yes to remove the discontinued orders tracking entries after printing."
+5 SET DIR("?",1)="The records you have viewed are from a temporary tracking file"
+6 SET DIR("?",2)="and they can be deleted without any impact to the orders file."
+7 DO ^DIR
+8 IF $DATA(DIRUT)
QUIT -1
+9 QUIT Y
+10 ;
DELETE(NODE) ;
+1 ;
+2 NEW DIK,WDIEN,ODT,OIEN,DA,HOLD
+3 SET DIK="^PS(52.75,"
+4 SET WDIEN=0
+5 FOR
SET WDIEN=$ORDER(^TMP(NODE,$JOB,WDIEN))
if (WDIEN'>0)!PSIVQT
QUIT
Begin DoDot:1
+6 SET ODT=0
+7 FOR
SET ODT=$ORDER(^TMP(NODE,$JOB,WDIEN,ODT))
if (ODT'>0)!PSIVQT
QUIT
Begin DoDot:2
+8 SET OIEN=0
+9 FOR
SET OIEN=$ORDER(^TMP(NODE,$JOB,WDIEN,ODT,OIEN))
if OIEN'>0
QUIT
Begin DoDot:3
+10 SET DA=OIEN
DO ^DIK
+11 IF $EXTRACT(IOST,1,2)="C-"
WRITE "."
End DoDot:3
End DoDot:2
End DoDot:1
+12 IF $EXTRACT(IOST,1,2)="C-"
Begin DoDot:1
+13 WRITE !," Records which you have viewed or printed from"
+14 WRITE !," the temporary file--IV MEDICATION ORDERS DC'D (#52.75)"
+15 WRITE !," have been removed."
+16 SET HOLD=$$ASK(1)
End DoDot:1
+17 QUIT
+1 NEW PSIVI
+2 SET $PIECE(PSIVI,"-",80)=""
+3 SET PSIVLN=4
+4 WRITE @IOF,!,?(IOM-$LENGTH(RPTITLE1))\2,RPTITLE1
+5 WRITE !,?(IOM-$LENGTH(RPTITLE2))\2,RPTITLE2
+6 WRITE !?1,"WARD - ROOM/BED",?22,"DRUG",?42,"PATIENT",?59,"PID",?65,"DT/TM",!,PSIVI,!
+7 QUIT
+8 ;
ASK(HOLD) ;ask user 2 continue function
+1 ;return true (1) if user want's 2 stop, false (0) 2 continue.
+2 ;If HOLD defined, use prompt 2 hold display until user hits return.
+3 ;If not terminal then, do nothing, return FALSE.
+4 ;
+5 NEW STOP
SET STOP=0
+6 IF $EXTRACT(IOST,1,2)="C-"
Begin DoDot:1
+7 ;
+8 NEW RESP,DIR
SET RESP=0
+9 IF $GET(HOLD)
SET DIR(0)="EA"
SET DIR("A")="Enter return to continue. "
+10 IF '$TEST
SET DIR(0)="E"
+11 DO ^DIR
IF Y=""
SET STOP=0
+12 IF $DATA(DIRUT)
SET STOP=1
End DoDot:1
+13 QUIT STOP
+14 ;
PAUSE(PSIVLN) ;Btw screens
+1 ;not to bottom of page yet so don't do anything
+2 if '(($GET(PSIVLN)+4)>$GET(IOSL))
QUIT
+3 ;
+4 IF $EXTRACT(IOST,1,2)="C-"
Begin DoDot:1
+5 SET PSIVQT=$$ASK()
End DoDot:1
+6 if PSIVQT
QUIT
+7 DO HEADER(.PSIVLN)
+8 QUIT
+9 ;
TURNOFF(VALUE) ;entry point called from IV room Input transform field 21
+1 ;
+2 if $GET(VALUE)>0
QUIT 0
+3 NEW SURE,Y,X
+4 SET SURE=$$SURE^PSIVARH1()
+5 IF SURE
DO CLEAN^PSIVARH1
+6 QUIT 'SURE
+7 ;
EXIT DO ^%ZISC
+1 KILL PSIVRM,PSIVWD,WARD
+2 ;
+3 ; user can print, delete, or print and delete. if the print is queued,
+4 ; then the print logic cleans up TMP, otherwise we need to clean it up
+5 ; now.
+6 ;
+7 DO TMPCLEAN^PSIVARH1(TDNODE)
+8 DO TMPCLEAN^PSIVARH1(TPNODE)
+9 QUIT
+10 ;
