PSJHL6 ;BIR/LDT-ACTIONS ON HL7 MESSAGES FROM OE/RR (CONT) ;02 Mar 99 / 9:26 AM
;;5.0;INPATIENT MEDICATIONS ;**1,11,27,34,40,42,51,59,88,98,181,263,299**;16 DEC 97;Build 11
;
; Reference to EN^ORERR is supported by DBIA# 2187.
; Reference to ^PS(55 is supported by DBIA# 2191.
;
CANCEL ;Cancel or Discontinue orders thru OE/RR
N DA,DR,DIE,STATUS,STPDT,NODE,NODE2,PSREASON,PSIVACT,PSIVALT,ON55,PSIVREA,PSIVALCK,P,PSJADC
S NODE=$G(@(RXORDER_"0)")),NODE2=$G(@(RXORDER_"2)"))
I 'NODE S PSREASON="Invalid Pharmacy order number" D Q
.S X="ORERR" X ^%ZOSF("TEST") I D EN^ORERR(PSREASON_"/DC Msg",.PSJMSG)
.D EN1^PSJHLERR(PSJHLDFN,$S(PSOC="CA":"UC",1:"UD"),$P(ORDER,U),PSREASON)
I RXON["P",PSJHLDFN'=$P(NODE,U,15) S ORDCON="Patient does not match/Discontinue Msg" D Q
.S X="ORERR" X ^%ZOSF("TEST") I D EN^ORERR(ORDCON,.PSJMSG)
.D EN1^PSJHLERR(PSJHLDFN,$S(PSOC="CA":"UC",1:"UD"),$P(ORDER,U),ORDCON)
S $P(@(RXORDER_"0)"),"^",21)=$P(ORDER,"^",1)
S STATUS=$S(RXON["V":$P(NODE,"^",17),1:$P(NODE,"^",9))
S STPDT=$S(RXON["V":$P(NODE,"^",3),1:$P(NODE2,"^",4))
I "AHNOPR"'[STATUS D @STATUS S PSREASON=PSREASON_" orders may not be "_$S(PSOC="CA":"cancelled",1:"discontinued") D EN1^PSJHL2(PSJHLDFN,$S(PSOC="CA":"UC",1:"UD"),RXON,PSREASON) Q
S:(RXON["A")!(RXON["U")!(RXON["V") DA(1)=PSJHLDFN,DA=+RXON
S PSJADC=$S($G(ORDCON)="A":"DA",1:"DP")
D NOW^%DTC
S DIE=$S(RXON["V":"^PS(55,"_PSJHLDFN_",""IV"",",(RXON["N")!(RXON["P"):"^PS(53.1,",1:"^PS(55,"_PSJHLDFN_",5,"),DA=+RXON
I (RXON["N")!(RXON["P") D KILL531^PSJIMO1(PSJHLDFN,"",+RXON)
S DR=$S(RXON["V":"100////D;157////"_PSJADC_";116////^S X=STPDT;.03////",(RXON["N")!(RXON["P"):"28////D;25////",1:"25////^S X=STPDT;28////D;136////"_PSJADC_";34////")_$S($G(ORDCON)="A"&($G(PSJASTP)'=""):$G(PSJASTP),1:%)
I RXON["A"!(RXON["U") S PSGAL("C")=$S($G(ORDCON)="A":1040,1:4000) D ^PSGAL5
I RXON["V" S PSIVACT=1,PSIVALT=$S($G(ORDCON)="A":"",1:2),PSIVAL=$S($G(ORDCON)="A":"AUTO DISCONTINUED (TREATING SPECIALTY TRANSFER)",1:""),ON55=RXON,PSIVREA="D",P(3)=STPDT
S:$G(ORDCON)="A" DR=$S(RXON["V":DR_";121////1",RXON["N"!(RXON["P"):DR_";42////1",1:DR_";49////1")
D ^DIE
S:$G(ORDCON)="A" $P(^PS(55,PSJHLDFN,5.1),"^")=""
I RXON["V" N DFN S DFN=PSJHLDFN D LOG^PSIVORAL
D EN1^PSJHL2(PSJHLDFN,$S(PSOC="CA":"CR",1:"DR"),RXON)
D NOW^%DTC I "ANR"[STATUS I STPDT<% D EXPIR Q
D AUE(PSJHLDFN,RXON)
Q
;
HOLD ;Place orders on hold thru OE/RR and check for expired orders
N DA,DR,DIE,STATUS,STPDT,NODE,NODE2,PSREASON,PSIVACT,PSIVALT,PSIVREA,ON55
S NODE=$G(@(RXORDER_"0)")),NODE2=$G(@(RXORDER_"2)"))
I 'NODE S PSREASON="Invalid Pharmacy order number" D Q
.S X="ORERR" X ^%ZOSF("TEST") I D EN^ORERR(PSREASON_"/Hold Msg",.PSJMSG)
.D EN1^PSJHLERR(PSJHLDFN,"UH",$P(ORDER,U),PSREASON)
S $P(@(RXORDER_"0)"),"^",21)=$P(ORDER,"^",1)
S STATUS=$S(RXON["V":$P(NODE,"^",17),1:$P(NODE,"^",9))
S STPDT=$S(RXON["V":$P(NODE,"^",3),1:$P(NODE2,"^",4))
D NOW^%DTC I "ANR"[STATUS I STPDT<% D EXPIR
I STATUS'="A" D @STATUS S PSREASON=PSREASON_" orders may not be placed on hold" D EN1^PSJHL2(PSJHLDFN,"UH",RXON,PSREASON) Q
I STATUS="A" D
.S DA(1)=PSJHLDFN,DA=+RXON
.S DIE=$S(RXON["V":"^PS(55,"_PSJHLDFN_",""IV"",",1:"^PS(55,"_PSJHLDFN_",5,")
.S DR=$S(RXON["V":"100////H;157////HP;120////1;149////1",1:"28////H;136////HP;56////1;59////A;59.1////1;60////@;61////@;62////@;58////"_%)
I RXON["A"!(RXON["U") S PSGAL("C")=8500 D ^PSGAL5
S:RXON["V" PSIVACT=1,PSIVALT=2,PSIVREA="H",ON55=RXON
D ^DIE
I RXON["V" N DFN S DFN=PSJHLDFN D LOG^PSIVORAL
D EN1^PSJHL2(PSJHLDFN,"HR",RXON)
D NOW^%DTC I "ANR"[STATUS I STPDT<% D EXPIR Q
D AUE(PSJHLDFN,RXON)
Q
;
UNHOLD ;Change status of orders placed on hold thru OE/RR & check for expired orders
N DA,DR,DIE,STATUS,STPDT,NODE,NODE2,NODE4,HFLAG,PSREASON,PSIVACT,PSIVALT,PSIVREA,ON55
S NODE=$G(@(RXORDER_"0)")),NODE2=$G(@(RXORDER_"2)")),NODE4=$G(@(RXORDER_"4)"))
I 'NODE S PSREASON="Invalid Pharmacy order number" D Q
.S X="ORERR" X ^%ZOSF("TEST") I D EN^ORERR(PSREASON_"/Unhold Msg",.PSJMSG)
.D EN1^PSJHLERR(PSJHLDFN,"UR",$P(ORDER,U),PSREASON)
S $P(@(RXORDER_"0)"),"^",21)=$P(ORDER,"^",1)
S STATUS=$S(RXON["V":$P(NODE,"^",17),1:$P(NODE,"^",9))
S STPDT=$S(RXON["V":$P(NODE,"^",3),1:$P(NODE2,"^",4))
S HFLAG=$S(RXON["V":$P(NODE,"^",10),1:$P(NODE4,"^",26))
I 'HFLAG S PSREASON="Orders placed on hold by Pharmacy may not be removed from hold through CPRS." D EN1^PSJHL2(PSJHLDFN,"UR",RXON,PSREASON) Q
I "H"'[STATUS D @STATUS S PSREASON=PSREASON_" orders may not be taken off hold" D EN1^PSJHL2(PSJHLDFN,"UR",RXON,PSREASON) Q
I STATUS="H" S DA(1)=PSJHLDFN,DA=+RXON,DIE=$S(RXON["V":"^PS(55,"_PSJHLDFN_",""IV"",",1:"^PS(55,"_PSJHLDFN_",5,")
D NOW^%DTC
S DR=$S(RXON["V":"100////A;157////@;120////@;149////@",1:"28////A;136////@;56////@;57////@;58////@;59////@;59.1////@;60////1;62////"_%)
I RXON["A"!(RXON["U") S PSGAL("C")=8000 D ^PSGAL5
S:RXON["V" PSIVACT=1,PSIVALT=2,PSIVREA="U",ON55=RXON
D ^DIE
I RXON["V" N DFN S DFN=PSJHLDFN D LOG^PSIVORAL
D EN1^PSJHL2(PSJHLDFN,"OR",RXON)
D NOW^%DTC I "A"[STATUS I STPDT<% D EXPIR Q
D AUE(PSJHLDFN,RXON)
Q
EXPIR ;Change status of order to expired and send notice to OE/RR
N DA,DIE,DR,PSGPO,PSIVACT
S STATUS="E",(PSGPO,PSIVACT)=1,DA=+RXON,DA(1)=PSJHLDFN,DIE=$S(RXON["V":"^PS(55,"_PSJHLDFN_",""IV"",",1:"^PS(55,"_PSJHLDFN_",5,"),DR=$S(RXON["V":"100////E",1:"28////E") D ^DIE
S PSJHLMTN="ORM" D EN1^PSJHL2(PSJHLDFN,"SC",RXON) S PSJHLMTN="ORR"
;D AUE(PSJHLDFN,RXON)
Q
AUE(PSJHLDFN,ON) ; Set "AUE" xref for 55.06 if hold/unhold
I ON["A"!(ON["U") S ^PS(55,"AUE",PSJHLDFN,+ON)=""
Q
;
A S PSREASON="Active" Q
D S PSREASON="Discontinued" Q
I S PSREASON="Incomplete" Q
N S PSREASON="Non-verified" Q
U S PSREASON="Unreleased" Q
P S PSREASON="Pending" Q
DE S PSREASON="Discontinued (edit)" Q
E S PSREASON="Expired" Q
H S PSREASON="Hold" Q
R S PSREASON="Renewed" Q
RE S PSREASON="Reinstated" Q
DR S PSREASON="Discontinued (renewal)" Q
O S PSREASON="On call" Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSJHL6 5995 printed Sep 23, 2025@19:43:08 Page 2
PSJHL6 ;BIR/LDT-ACTIONS ON HL7 MESSAGES FROM OE/RR (CONT) ;02 Mar 99 / 9:26 AM
+1 ;;5.0;INPATIENT MEDICATIONS ;**1,11,27,34,40,42,51,59,88,98,181,263,299**;16 DEC 97;Build 11
+2 ;
+3 ; Reference to EN^ORERR is supported by DBIA# 2187.
+4 ; Reference to ^PS(55 is supported by DBIA# 2191.
+5 ;
CANCEL ;Cancel or Discontinue orders thru OE/RR
+1 NEW DA,DR,DIE,STATUS,STPDT,NODE,NODE2,PSREASON,PSIVACT,PSIVALT,ON55,PSIVREA,PSIVALCK,P,PSJADC
+2 SET NODE=$GET(@(RXORDER_"0)"))
SET NODE2=$GET(@(RXORDER_"2)"))
+3 IF 'NODE
SET PSREASON="Invalid Pharmacy order number"
Begin DoDot:1
+4 SET X="ORERR"
XECUTE ^%ZOSF("TEST")
IF $TEST
DO EN^ORERR(PSREASON_"/DC Msg",.PSJMSG)
+5 DO EN1^PSJHLERR(PSJHLDFN,$SELECT(PSOC="CA":"UC",1:"UD"),$PIECE(ORDER,U),PSREASON)
End DoDot:1
QUIT
+6 IF RXON["P"
IF PSJHLDFN'=$PIECE(NODE,U,15)
SET ORDCON="Patient does not match/Discontinue Msg"
Begin DoDot:1
+7 SET X="ORERR"
XECUTE ^%ZOSF("TEST")
IF $TEST
DO EN^ORERR(ORDCON,.PSJMSG)
+8 DO EN1^PSJHLERR(PSJHLDFN,$SELECT(PSOC="CA":"UC",1:"UD"),$PIECE(ORDER,U),ORDCON)
End DoDot:1
QUIT
+9 SET $PIECE(@(RXORDER_"0)"),"^",21)=$PIECE(ORDER,"^",1)
+10 SET STATUS=$SELECT(RXON["V":$PIECE(NODE,"^",17),1:$PIECE(NODE,"^",9))
+11 SET STPDT=$SELECT(RXON["V":$PIECE(NODE,"^",3),1:$PIECE(NODE2,"^",4))
+12 IF "AHNOPR"'[STATUS
DO @STATUS
SET PSREASON=PSREASON_" orders may not be "_$SELECT(PSOC="CA":"cancelled",1:"discontinued")
DO EN1^PSJHL2(PSJHLDFN,$SELECT(PSOC="CA":"UC",1:"UD"),RXON,PSREASON)
QUIT
+13 if (RXON["A")!(RXON["U")!(RXON["V")
SET DA(1)=PSJHLDFN
SET DA=+RXON
+14 SET PSJADC=$SELECT($GET(ORDCON)="A":"DA",1:"DP")
+15 DO NOW^%DTC
+16 SET DIE=$SELECT(RXON["V":"^PS(55,"_PSJHLDFN_",""IV"",",(RXON["N")!(RXON["P"):"^PS(53.1,",1:"^PS(55,"_PSJHLDFN_",5,")
SET DA=+RXON
+17 IF (RXON["N")!(RXON["P")
DO KILL531^PSJIMO1(PSJHLDFN,"",+RXON)
+18 SET DR=$SELECT(RXON["V":"100////D;157////"_PSJADC_";116////^S X=STPDT;.03////",(RXON["N")!(RXON["P"):"28////D;25////",1:"25////^S X=STPDT;28////D;136////"_PSJADC_";34////")_$SELECT($GET(ORDCON)="A"&($GET(PSJASTP)'=""):$GET(PSJASTP),1:%)
+19 IF RXON["A"!(RXON["U")
SET PSGAL("C")=$SELECT($GET(ORDCON)="A":1040,1:4000)
DO ^PSGAL5
+20 IF RXON["V"
SET PSIVACT=1
SET PSIVALT=$SELECT($GET(ORDCON)="A":"",1:2)
SET PSIVAL=$SELECT($GET(ORDCON)="A":"AUTO DISCONTINUED (TREATING SPECIALTY TRANSFER)",1:"")
SET ON55=RXON
SET PSIVREA="D"
SET P(3)=STPDT
+21 if $GET(ORDCON)="A"
SET DR=$SELECT(RXON["V":DR_";121////1",RXON["N"!(RXON["P"):DR_";42////1",1:DR_";49////1")
+22 DO ^DIE
+23 if $GET(ORDCON)="A"
SET $PIECE(^PS(55,PSJHLDFN,5.1),"^")=""
+24 IF RXON["V"
NEW DFN
SET DFN=PSJHLDFN
DO LOG^PSIVORAL
+25 DO EN1^PSJHL2(PSJHLDFN,$SELECT(PSOC="CA":"CR",1:"DR"),RXON)
+26 DO NOW^%DTC
IF "ANR"[STATUS
IF STPDT<%
DO EXPIR
QUIT
+27 DO AUE(PSJHLDFN,RXON)
+28 QUIT
+29 ;
HOLD ;Place orders on hold thru OE/RR and check for expired orders
+1 NEW DA,DR,DIE,STATUS,STPDT,NODE,NODE2,PSREASON,PSIVACT,PSIVALT,PSIVREA,ON55
+2 SET NODE=$GET(@(RXORDER_"0)"))
SET NODE2=$GET(@(RXORDER_"2)"))
+3 IF 'NODE
SET PSREASON="Invalid Pharmacy order number"
Begin DoDot:1
+4 SET X="ORERR"
XECUTE ^%ZOSF("TEST")
IF $TEST
DO EN^ORERR(PSREASON_"/Hold Msg",.PSJMSG)
+5 DO EN1^PSJHLERR(PSJHLDFN,"UH",$PIECE(ORDER,U),PSREASON)
End DoDot:1
QUIT
+6 SET $PIECE(@(RXORDER_"0)"),"^",21)=$PIECE(ORDER,"^",1)
+7 SET STATUS=$SELECT(RXON["V":$PIECE(NODE,"^",17),1:$PIECE(NODE,"^",9))
+8 SET STPDT=$SELECT(RXON["V":$PIECE(NODE,"^",3),1:$PIECE(NODE2,"^",4))
+9 DO NOW^%DTC
IF "ANR"[STATUS
IF STPDT<%
DO EXPIR
+10 IF STATUS'="A"
DO @STATUS
SET PSREASON=PSREASON_" orders may not be placed on hold"
DO EN1^PSJHL2(PSJHLDFN,"UH",RXON,PSREASON)
QUIT
+11 IF STATUS="A"
Begin DoDot:1
+12 SET DA(1)=PSJHLDFN
SET DA=+RXON
+13 SET DIE=$SELECT(RXON["V":"^PS(55,"_PSJHLDFN_",""IV"",",1:"^PS(55,"_PSJHLDFN_",5,")
+14 SET DR=$SELECT(RXON["V":"100////H;157////HP;120////1;149////1",1:"28////H;136////HP;56////1;59////A;59.1////1;60////@;61////@;62////@;58////"_%)
End DoDot:1
+15 IF RXON["A"!(RXON["U")
SET PSGAL("C")=8500
DO ^PSGAL5
+16 if RXON["V"
SET PSIVACT=1
SET PSIVALT=2
SET PSIVREA="H"
SET ON55=RXON
+17 DO ^DIE
+18 IF RXON["V"
NEW DFN
SET DFN=PSJHLDFN
DO LOG^PSIVORAL
+19 DO EN1^PSJHL2(PSJHLDFN,"HR",RXON)
+20 DO NOW^%DTC
IF "ANR"[STATUS
IF STPDT<%
DO EXPIR
QUIT
+21 DO AUE(PSJHLDFN,RXON)
+22 QUIT
+23 ;
UNHOLD ;Change status of orders placed on hold thru OE/RR & check for expired orders
+1 NEW DA,DR,DIE,STATUS,STPDT,NODE,NODE2,NODE4,HFLAG,PSREASON,PSIVACT,PSIVALT,PSIVREA,ON55
+2 SET NODE=$GET(@(RXORDER_"0)"))
SET NODE2=$GET(@(RXORDER_"2)"))
SET NODE4=$GET(@(RXORDER_"4)"))
+3 IF 'NODE
SET PSREASON="Invalid Pharmacy order number"
Begin DoDot:1
+4 SET X="ORERR"
XECUTE ^%ZOSF("TEST")
IF $TEST
DO EN^ORERR(PSREASON_"/Unhold Msg",.PSJMSG)
+5 DO EN1^PSJHLERR(PSJHLDFN,"UR",$PIECE(ORDER,U),PSREASON)
End DoDot:1
QUIT
+6 SET $PIECE(@(RXORDER_"0)"),"^",21)=$PIECE(ORDER,"^",1)
+7 SET STATUS=$SELECT(RXON["V":$PIECE(NODE,"^",17),1:$PIECE(NODE,"^",9))
+8 SET STPDT=$SELECT(RXON["V":$PIECE(NODE,"^",3),1:$PIECE(NODE2,"^",4))
+9 SET HFLAG=$SELECT(RXON["V":$PIECE(NODE,"^",10),1:$PIECE(NODE4,"^",26))
+10 IF 'HFLAG
SET PSREASON="Orders placed on hold by Pharmacy may not be removed from hold through CPRS."
DO EN1^PSJHL2(PSJHLDFN,"UR",RXON,PSREASON)
QUIT
+11 IF "H"'[STATUS
DO @STATUS
SET PSREASON=PSREASON_" orders may not be taken off hold"
DO EN1^PSJHL2(PSJHLDFN,"UR",RXON,PSREASON)
QUIT
+12 IF STATUS="H"
SET DA(1)=PSJHLDFN
SET DA=+RXON
SET DIE=$SELECT(RXON["V":"^PS(55,"_PSJHLDFN_",""IV"",",1:"^PS(55,"_PSJHLDFN_",5,")
+13 DO NOW^%DTC
+14 SET DR=$SELECT(RXON["V":"100////A;157////@;120////@;149////@",1:"28////A;136////@;56////@;57////@;58////@;59////@;59.1////@;60////1;62////"_%)
+15 IF RXON["A"!(RXON["U")
SET PSGAL("C")=8000
DO ^PSGAL5
+16 if RXON["V"
SET PSIVACT=1
SET PSIVALT=2
SET PSIVREA="U"
SET ON55=RXON
+17 DO ^DIE
+18 IF RXON["V"
NEW DFN
SET DFN=PSJHLDFN
DO LOG^PSIVORAL
+19 DO EN1^PSJHL2(PSJHLDFN,"OR",RXON)
+20 DO NOW^%DTC
IF "A"[STATUS
IF STPDT<%
DO EXPIR
QUIT
+21 DO AUE(PSJHLDFN,RXON)
+22 QUIT
EXPIR ;Change status of order to expired and send notice to OE/RR
+1 NEW DA,DIE,DR,PSGPO,PSIVACT
+2 SET STATUS="E"
SET (PSGPO,PSIVACT)=1
SET DA=+RXON
SET DA(1)=PSJHLDFN
SET DIE=$SELECT(RXON["V":"^PS(55,"_PSJHLDFN_",""IV"",",1:"^PS(55,"_PSJHLDFN_",5,")
SET DR=$SELECT(RXON["V":"100////E",1:"28////E")
DO ^DIE
+3 SET PSJHLMTN="ORM"
DO EN1^PSJHL2(PSJHLDFN,"SC",RXON)
SET PSJHLMTN="ORR"
+4 ;D AUE(PSJHLDFN,RXON)
+5 QUIT
AUE(PSJHLDFN,ON) ; Set "AUE" xref for 55.06 if hold/unhold
+1 IF ON["A"!(ON["U")
SET ^PS(55,"AUE",PSJHLDFN,+ON)=""
+2 QUIT
+3 ;
A SET PSREASON="Active"
QUIT
D SET PSREASON="Discontinued"
QUIT
I SET PSREASON="Incomplete"
QUIT
N SET PSREASON="Non-verified"
QUIT
U SET PSREASON="Unreleased"
QUIT
P SET PSREASON="Pending"
QUIT
DE SET PSREASON="Discontinued (edit)"
QUIT
E SET PSREASON="Expired"
QUIT
H SET PSREASON="Hold"
QUIT
R SET PSREASON="Renewed"
QUIT
RE SET PSREASON="Reinstated"
QUIT
DR SET PSREASON="Discontinued (renewal)"
QUIT
O SET PSREASON="On call"
QUIT
