PSIVARH1 ;AAC/JLS - DISPLAY RECENTLY DC'D IV ORDERS ; 10/18/15 / 9:27 AM
;;5.0;INPATIENT MEDICATIONS;**325**;;Build 37
;
;called from DECODE^PSIVARH
;
DECODE ;decode backdoor hl7 PSIVMSG
N PSIVA,PSIVB
K PSIVFLD
S PSIVA=0 F S PSIVA=$O(PSIVMSG(PSIVA)) Q:'PSIVA D
.F PSIVB=0:1:$L(PSIVMSG(PSIVA),"|") S PSIVFLD(PSIVB)=$P(PSIVMSG(PSIVA),"|",PSIVB+1)
.I PSIVFLD(0)="" Q
.I $T(@PSIVFLD(0))]"" D @PSIVFLD(0)
Q
MSH ;
S PSIVPKG=PSIVFLD(2) ;sending appl
S PSIVPKG(2)=PSIVFLD(4)
Q
PID ;
S DFN=PSIVFLD(3) ;dfn
Q
PV1 ;
S PSIVLOC=$G(PSIVFLD(3)) ;location
Q
ORC ;
S PSIVSTS=$G(PSIVFLD(1)) ;order control/status
S PSIVIFNF=$G(PSIVFLD(2)) ;placer order ien
S PSIVIFNP=$G(PSIVFLD(3)) ;filler order ien
S PSIVDUZ=$G(PSIVFLD(12)) ;requestor
S PSIVRDUZ=$G(PSIVFLD(10)) ;releaser
S PSIVEDT=$G(PSIVFLD(15)) ;effective dt
S:+PSIVEDT PSIVEDT=$$FMDATE^HLFNC(PSIVEDT)
S PSIVRDT=$G(PSIVFLD(9)) ;release dt
S:+PSIVRDT PSIVRDT=$$FMDATE^HLFNC(PSIVRDT)
Q
GETHRS(PSIVSN) ; function returns a date time in the past which is derived from
; the IV ROOM (59.5) file. This file contains parameters for the
; IV room(s). The parameter used is the DC'D IV ORDERS HOURS
; FILTER (#21) field. The function subtracts the value in the
; parameter file from NOW to get a date time in the past such that
; orders older than the returned date can be ignored.
;
; Return format:
; Internal date@time ^ External date@time ^ DC'D IV ORDERS HOURS FILTER
;
N IDT,XDT,% ;INTERNAL DATE/TIME, EXTERNAL DATE/TIME
N IVRFILT ;DC'D IV ORDERS HOURS FILTER
;
; PSIVSN = IV ROOM internal entry number returned by earlier call
; to MULT^PSIVSET
;
I $G(PSIVSN) S IVRFILT=$P($G(^PS(59.5,PSIVSN,6)),U)
S:$G(IVRFILT)="" IVRFILT=0
D NOW^%DTC
S IDT=$$FMADD^XLFDT(%,,-(IVRFILT),,-1)
S XDT=$$FMTE^XLFDT(IDT,"1P")
Q IDT_U_XDT_U_IVRFILT
;
;=====================================================================
ACTION() ;
W !!
N DIR,DUOUT,DTOUT,DIROUT,DIRUT,X,Y,ACTION
S PSIVQT=0
S DIR(0)="SB^P:Print;R:Refresh;D:Delete;I:Ignore",DIR("A")="(P)rint, (R)efresh, (D)elete, or (I)gnore?"
S DIR("B")="I"
S DIR("?",1)=" The records you are viewing are temporary and are stored"
S DIR("?",2)=" in the IV MEDICATION ORDERS DC'D (#52.75) file. These "
S DIR("?",3)=" records are intended to help identify discontinued IV orders"
S DIR("?",4)=" for a particular ward or a ward group."
S DIR("?",5)=" (P)rint action allows the viewed orders to be printed to a device and"
S DIR("?",6)=" optionally those records can be deleted, once printed."
S DIR("?",7)=" (R)efresh action, simply re-displays the records."
S DIR("?",8)=" (D)elete action removes the currently viewed records from the file so"
S DIR("?",9)=" they will no longer be displayed."
S DIR("?",10)=" (I)gnore action will continue with the usual next prompt and take no"
S DIR("?",11)=" action on the records."
S DIR("?")=" Enter an action (P),(R),(D) or (I) for the records you have just viewed."
D ^DIR S ACTION=Y
;
Q ACTION
;
ISDATAG(WG) ;
; FUNCTION (BOOLEAN) RETURNS TRUE IF THERE ARE RECORDS THAT FIT FILTER (GROUP)
; check for data in any of the wards that are part of the group
;
N VDA,VWDI,FOUND,WRDIEN,WARD
S FOUND=0
;
S VWDI=0
F S VWDI=$O(^PS(57.5,WG,1,"B",VWDI)) Q:'VWDI!FOUND D
. S WRDIEN=+$G(^DIC(42,VWDI,44))
. I $G(WRDIEN)>0 S FOUND=$$ISDATAW(WRDIEN)
Q FOUND
;
ISDATAW(WRDIEN) ;
;FUNCTION (BOOLEAN) RETURNS TRUE IF THERE ARE RECORDS THAT FIT FILTER (WARD)
;
N IEN,FOUND,THISHR
S FOUND=0
S THISHR=$P(HRSFILT,U,1)
F S THISHR=$O(^PS(52.75,"AW",WRDIEN,THISHR)) Q:'THISHR!FOUND D
. S IEN=""
. S FOUND=+$O(^PS(52.75,"AW",WRDIEN,THISHR,IEN))
Q FOUND
;
NODCD(PLACE,WHEN) ;
;DISPLAY A MESSAGE IF THERE ARE NO D/C'D ORDERS OR NONE THAT ARE WITHIN THE FILTER PERIOD
W !!?2,"No edited or discontinued IV orders are in the"
W !?2,"temporary tracking file (#52.75) for ",PLACE
W !?2,"from the past ",WHEN," hour(s).",!!
Q
YOURSURE() ; ask user if they are sure about deleting
N DIR,DUOUT,DTOUT,DIROUT,DIRUT,X,Y
S DIR("B")="Y"
S DIR(0)="Y",DIR("A")="Are you sure you want to remove the records you have just viewed"
S DIR("?")="Answer yes to remove the discontinued orders tracking entries."
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
TMPCLEAN(NODE) ;
;
K ^TMP(NODE,$J)
Q
SURE() ;
;
N DIR,DUOUT,DTOUT,DIROUT,DIRUT,X,Y,DA
W !!," Entering a zero or deleting this parameter will turn"
W !," off the Discontinued IV Report when processing orders"
W !," under this IV room. By entering a zero, any existing"
W !," entries will be removed under this IV room.",!
S DIR("B")="N"
S DIR(0)="Y",DIR("A")="Turn off Discontinued IV Report"
S DIR("?",1)="Answer Yes to Turn off the Discontinued IV report that is"
S DIR("?")="run within the option Non-Verified/Pending Orders [PSJU VBW]."
D ^DIR
I $D(DIRUT) Q -1
Q Y
;
CLEAN ;
;THIS CODE IS EXECUTED FROM AC CROSS REFERENCE ON FIELD 21 IN #52.75
;REMOVE ENTRIES FOR THIS IV ROOM IF OPTION BEING TURNED OFF
;DA IS CURRENT IV ROOM (*)
;X IS NEW VALUE FOR FIELD 21; Y IS PREVIOUS VALUE FOR 21
N DIK,OIEN,PHPTI,ORDERN,PHPZN,IVR,IVRDA,DELCOUNT
S DIK="^PS(52.75,"
S DELCOUNT=0
S IVRDA=+DA
N DA
S OIEN=0
F S OIEN=$O(^PS(52.75,OIEN)) Q:OIEN'>0 D
. S PHPZN=$G(^PS(52.75,OIEN,0))
. S PHPTI=$P(PHPZN,U,2)
. S ORDERN=+$P(PHPZN,U,8)
. S IVR=$$IVROOM^PSIVARH(PHPTI,ORDERN)
. Q:'(+IVR=IVRDA)
. S DA=OIEN D ^DIK
. S DELCOUNT=DELCOUNT+1
I DELCOUNT>0 W !,DELCOUNT," records deleted."
E W !,"There were no records to delete."
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSIVARH1 6599 printed Sep 23, 2025@19:40:01 Page 2
PSIVARH1 ;AAC/JLS - DISPLAY RECENTLY DC'D IV ORDERS ; 10/18/15 / 9:27 AM
+1 ;;5.0;INPATIENT MEDICATIONS;**325**;;Build 37
+2 ;
+3 ;called from DECODE^PSIVARH
+4 ;
DECODE ;decode backdoor hl7 PSIVMSG
+1 NEW PSIVA,PSIVB
+2 KILL PSIVFLD
+3 SET PSIVA=0
FOR
SET PSIVA=$ORDER(PSIVMSG(PSIVA))
if 'PSIVA
QUIT
Begin DoDot:1
+4 FOR PSIVB=0:1:$LENGTH(PSIVMSG(PSIVA),"|")
SET PSIVFLD(PSIVB)=$PIECE(PSIVMSG(PSIVA),"|",PSIVB+1)
+5 IF PSIVFLD(0)=""
QUIT
+6 IF $TEXT(@PSIVFLD(0))]""
DO @PSIVFLD(0)
End DoDot:1
+7 QUIT
MSH ;
+1 ;sending appl
SET PSIVPKG=PSIVFLD(2)
+2 SET PSIVPKG(2)=PSIVFLD(4)
+3 QUIT
PID ;
+1 ;dfn
SET DFN=PSIVFLD(3)
+2 QUIT
PV1 ;
+1 ;location
SET PSIVLOC=$GET(PSIVFLD(3))
+2 QUIT
ORC ;
+1 ;order control/status
SET PSIVSTS=$GET(PSIVFLD(1))
+2 ;placer order ien
SET PSIVIFNF=$GET(PSIVFLD(2))
+3 ;filler order ien
SET PSIVIFNP=$GET(PSIVFLD(3))
+4 ;requestor
SET PSIVDUZ=$GET(PSIVFLD(12))
+5 ;releaser
SET PSIVRDUZ=$GET(PSIVFLD(10))
+6 ;effective dt
SET PSIVEDT=$GET(PSIVFLD(15))
+7 if +PSIVEDT
SET PSIVEDT=$$FMDATE^HLFNC(PSIVEDT)
+8 ;release dt
SET PSIVRDT=$GET(PSIVFLD(9))
+9 if +PSIVRDT
SET PSIVRDT=$$FMDATE^HLFNC(PSIVRDT)
+10 QUIT
GETHRS(PSIVSN) ; function returns a date time in the past which is derived from
+1 ; the IV ROOM (59.5) file. This file contains parameters for the
+2 ; IV room(s). The parameter used is the DC'D IV ORDERS HOURS
+3 ; FILTER (#21) field. The function subtracts the value in the
+4 ; parameter file from NOW to get a date time in the past such that
+5 ; orders older than the returned date can be ignored.
+6 ;
+7 ; Return format:
+8 ; Internal date@time ^ External date@time ^ DC'D IV ORDERS HOURS FILTER
+9 ;
+10 ;INTERNAL DATE/TIME, EXTERNAL DATE/TIME
NEW IDT,XDT,%
+11 ;DC'D IV ORDERS HOURS FILTER
NEW IVRFILT
+12 ;
+13 ; PSIVSN = IV ROOM internal entry number returned by earlier call
+14 ; to MULT^PSIVSET
+15 ;
+16 IF $GET(PSIVSN)
SET IVRFILT=$PIECE($GET(^PS(59.5,PSIVSN,6)),U)
+17 if $GET(IVRFILT)=""
SET IVRFILT=0
+18 DO NOW^%DTC
+19 SET IDT=$$FMADD^XLFDT(%,,-(IVRFILT),,-1)
+20 SET XDT=$$FMTE^XLFDT(IDT,"1P")
+21 QUIT IDT_U_XDT_U_IVRFILT
+22 ;
+23 ;=====================================================================
ACTION() ;
+1 WRITE !!
+2 NEW DIR,DUOUT,DTOUT,DIROUT,DIRUT,X,Y,ACTION
+3 SET PSIVQT=0
+4 SET DIR(0)="SB^P:Print;R:Refresh;D:Delete;I:Ignore"
SET DIR("A")="(P)rint, (R)efresh, (D)elete, or (I)gnore?"
+5 SET DIR("B")="I"
+6 SET DIR("?",1)=" The records you are viewing are temporary and are stored"
+7 SET DIR("?",2)=" in the IV MEDICATION ORDERS DC'D (#52.75) file. These "
+8 SET DIR("?",3)=" records are intended to help identify discontinued IV orders"
+9 SET DIR("?",4)=" for a particular ward or a ward group."
+10 SET DIR("?",5)=" (P)rint action allows the viewed orders to be printed to a device and"
+11 SET DIR("?",6)=" optionally those records can be deleted, once printed."
+12 SET DIR("?",7)=" (R)efresh action, simply re-displays the records."
+13 SET DIR("?",8)=" (D)elete action removes the currently viewed records from the file so"
+14 SET DIR("?",9)=" they will no longer be displayed."
+15 SET DIR("?",10)=" (I)gnore action will continue with the usual next prompt and take no"
+16 SET DIR("?",11)=" action on the records."
+17 SET DIR("?")=" Enter an action (P),(R),(D) or (I) for the records you have just viewed."
+18 DO ^DIR
SET ACTION=Y
+19 ;
+20 QUIT ACTION
+21 ;
ISDATAG(WG) ;
+1 ; FUNCTION (BOOLEAN) RETURNS TRUE IF THERE ARE RECORDS THAT FIT FILTER (GROUP)
+2 ; check for data in any of the wards that are part of the group
+3 ;
+4 NEW VDA,VWDI,FOUND,WRDIEN,WARD
+5 SET FOUND=0
+6 ;
+7 SET VWDI=0
+8 FOR
SET VWDI=$ORDER(^PS(57.5,WG,1,"B",VWDI))
if 'VWDI!FOUND
QUIT
Begin DoDot:1
+9 SET WRDIEN=+$GET(^DIC(42,VWDI,44))
+10 IF $GET(WRDIEN)>0
SET FOUND=$$ISDATAW(WRDIEN)
End DoDot:1
+11 QUIT FOUND
+12 ;
ISDATAW(WRDIEN) ;
+1 ;FUNCTION (BOOLEAN) RETURNS TRUE IF THERE ARE RECORDS THAT FIT FILTER (WARD)
+2 ;
+3 NEW IEN,FOUND,THISHR
+4 SET FOUND=0
+5 SET THISHR=$PIECE(HRSFILT,U,1)
+6 FOR
SET THISHR=$ORDER(^PS(52.75,"AW",WRDIEN,THISHR))
if 'THISHR!FOUND
QUIT
Begin DoDot:1
+7 SET IEN=""
+8 SET FOUND=+$ORDER(^PS(52.75,"AW",WRDIEN,THISHR,IEN))
End DoDot:1
+9 QUIT FOUND
+10 ;
NODCD(PLACE,WHEN) ;
+1 ;DISPLAY A MESSAGE IF THERE ARE NO D/C'D ORDERS OR NONE THAT ARE WITHIN THE FILTER PERIOD
+2 WRITE !!?2,"No edited or discontinued IV orders are in the"
+3 WRITE !?2,"temporary tracking file (#52.75) for ",PLACE
+4 WRITE !?2,"from the past ",WHEN," hour(s).",!!
+5 QUIT
YOURSURE() ; ask user if they are sure about deleting
+1 NEW DIR,DUOUT,DTOUT,DIROUT,DIRUT,X,Y
+2 SET DIR("B")="Y"
+3 SET DIR(0)="Y"
SET DIR("A")="Are you sure you want to remove the records you have just viewed"
+4 SET DIR("?")="Answer yes to remove the discontinued orders tracking entries."
+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
TMPCLEAN(NODE) ;
+1 ;
+2 KILL ^TMP(NODE,$JOB)
+3 QUIT
SURE() ;
+1 ;
+2 NEW DIR,DUOUT,DTOUT,DIROUT,DIRUT,X,Y,DA
+3 WRITE !!," Entering a zero or deleting this parameter will turn"
+4 WRITE !," off the Discontinued IV Report when processing orders"
+5 WRITE !," under this IV room. By entering a zero, any existing"
+6 WRITE !," entries will be removed under this IV room.",!
+7 SET DIR("B")="N"
+8 SET DIR(0)="Y"
SET DIR("A")="Turn off Discontinued IV Report"
+9 SET DIR("?",1)="Answer Yes to Turn off the Discontinued IV report that is"
+10 SET DIR("?")="run within the option Non-Verified/Pending Orders [PSJU VBW]."
+11 DO ^DIR
+12 IF $DATA(DIRUT)
QUIT -1
+13 QUIT Y
+14 ;
CLEAN ;
+1 ;THIS CODE IS EXECUTED FROM AC CROSS REFERENCE ON FIELD 21 IN #52.75
+2 ;REMOVE ENTRIES FOR THIS IV ROOM IF OPTION BEING TURNED OFF
+3 ;DA IS CURRENT IV ROOM (*)
+4 ;X IS NEW VALUE FOR FIELD 21; Y IS PREVIOUS VALUE FOR 21
+5 NEW DIK,OIEN,PHPTI,ORDERN,PHPZN,IVR,IVRDA,DELCOUNT
+6 SET DIK="^PS(52.75,"
+7 SET DELCOUNT=0
+8 SET IVRDA=+DA
+9 NEW DA
+10 SET OIEN=0
+11 FOR
SET OIEN=$ORDER(^PS(52.75,OIEN))
if OIEN'>0
QUIT
Begin DoDot:1
+12 SET PHPZN=$GET(^PS(52.75,OIEN,0))
+13 SET PHPTI=$PIECE(PHPZN,U,2)
+14 SET ORDERN=+$PIECE(PHPZN,U,8)
+15 SET IVR=$$IVROOM^PSIVARH(PHPTI,ORDERN)
+16 if '(+IVR=IVRDA)
QUIT
+17 SET DA=OIEN
DO ^DIK
+18 SET DELCOUNT=DELCOUNT+1
End DoDot:1
+19 IF DELCOUNT>0
WRITE !,DELCOUNT," records deleted."
+20 IF '$TEST
WRITE !,"There were no records to delete."
+21 QUIT
+22 ;
