ORY350A ;ISP/JLC,RFR - POST-INSTALL FOR PATCH OR*3.0*350 ;04/27/2015 08:48
;;3.0;ORDER ENTRY/RESULTS REPORTING;**350**;Dec 17, 1997;Build 77
Q
SUPPLY ;correct entries in 101.43 and build list of supply
;entries in 101.44
N S1,S2,S3,PSOI,PSVAC,FDA,ORFIEN
K ^TMP($J,"ORY350A"),^TMP($J,"ORY350A1")
S S1="" F S S1=$O(^ORD(101.43,"S.SPLY",S1)) Q:S1="" D
. S S2=0
. F S S2=$O(^ORD(101.43,"S.SPLY",S1,S2)) Q:'S2 D
.. S ORFIEN=S2_",",PSOI=+$P(^ORD(101.43,S2,0),"^",2) D DRGIEN^PSS50P7(PSOI,"","ORY350A")
.. I ^TMP($J,"ORY350A",0)'>0 Q
.. S S3=0
.. F S S3=$O(^TMP($J,"ORY350A",S3)) Q:'S3 D
... D ZERO^PSS50(S3,,,,,"ORY350A1")
... I ^TMP($J,"ORY350A1",0)'>0 Q
... S PSVAC=$G(^TMP($J,"ORY350A1",S3,2)),FDA(101.43,ORFIEN,50.5)=0
... I PSVAC?1"XA".E!(PSVAC?1"XX".E)!(PSVAC="DX900"&($G(^TMP($J,"ORY350A1",S3,3))["S")) S FDA(101.43,ORFIEN,50.5)=1
... D FILE^DIE("","FDA")
;build supply item list for order dialog
D FVBLDQ^ORWUL("SPLY",1)
Q
NOTIFI() ;CREATE NEW NOTIFICATIONS
N ORFDA,ORIEN,ORERROR,ENT,PAR,INST,ORERROR,EXIT,ORVALUE
D MES^XPDUTL(" LAPSED UNSIGNED ORDER")
S ENT="PKG."_"ORDER ENTRY/RESULTS REPORTING",INST="LAPSED UNSIGNED ORDER"
S ORVALUE("ORB ARCHIVE PERIOD")=30
S ORVALUE("ORB DELETE MECHANISM")="Individual Recipient"
S ORVALUE("ORB FORWARD BACKUP REVIEWER")=0
S ORVALUE("ORB FORWARD SUPERVISOR")=0
S ORVALUE("ORB FORWARD SURROGATES")=0
S ORVALUE("ORB PROCESSING FLAG")="Disabled"
S ORVALUE("ORB PROVIDER RECIPIENTS")="OAPT"
S ORVALUE("ORB URGENCY")="High"
S PAR="" F S PAR=$O(ORVALUE(PAR)) Q:$G(PAR)=""!($G(EXIT)) D
.D EN^XPAR(ENT,PAR,INST,ORVALUE(PAR),.ORERROR) ;ICR #2336
.I +ORERROR D
..S ORMSG(1)=" ",EXIT=1
..S ORMSG(2)="ERROR: Unable to configure the new Lapsed Unsigned Order(s) notification"
..S ORMSG(3)="Kernel Parameter Tools Error #"_+ORERROR_": "_$P(ORERROR,U,2)
..D BMES^XPDUTL(.ORMSG)
Q:$G(EXIT) 0
Q 1
SQOCONV() ;CONVERT EXISTING OUTPATIENT MEDICATION QUICK ORDERS INTO SUPPLY QUICK ORDERS
N DG,DLG,ORTEXT
S DG("OUT")=$O(^ORD(100.98,"B","OUTPATIENT MEDICATIONS",0))
I +DG("OUT")=0 D Q 0
.S ORTEXT(1)="Unable to find the OUTPATIENT MEDICATIONS display group in the DISPLAY GROUP"
.S ORTEXT(2)="file (#100.98). Please log a Remedy ticket for assistance."
.D BMES^XPDUTL(.ORTEXT)
S DG("SUPPLY")=$O(^ORD(100.98,"B","SUPPLIES/DEVICES",0))
I +DG("SUPPLY")=0 D Q 0
.S ORTEXT(1)="Unable to find the SUPPLIES/DEVICES display group in the DISPLAY GROUP file"
.S ORTEXT(2)="(#100.98). Please log a Remedy ticket for assistance."
.D BMES^XPDUTL(.ORTEXT)
S DLG("ORDERABLE ITEM")=+$O(^ORD(101.41,"B","OR GTX ORDERABLE ITEM",0))
I DLG("ORDERABLE ITEM")=0 D Q 0
.S ORTEXT(1)="Unable to find the OR GTX ORDERABLE ITEM dialog in the ORDER DIALOG file"
.S ORTEXT(2)="(#101.41). Please log a Remedy ticket for assistance."
N IEN,EXIT
S IEN=0 F S IEN=$O(^ORD(101.41,IEN)) Q:+$G(IEN)=0!($G(EXIT)) D
.;SKIP DISABLED QUICK ORDER (FIELD #3 NOT BLANK)
.Q:$P(^ORD(101.41,IEN,0),U,3)'=""
.;SKIP NON-QUICK ORDER
.Q:$P(^ORD(101.41,IEN,0),U,4)'="Q"
.;SKIP NON-OUTPATIENT MEDICATIONS
.Q:$P(^ORD(101.41,IEN,0),U,5)'=DG("OUT")
.;DETERMINE IF THE ORDERABLE ITEM IS A SUPPLY
.N RIEN,ORPHOI,ORDRGIEN,SET
.S RIEN=+$O(^ORD(101.41,IEN,6,"D",DLG("ORDERABLE ITEM"),0))
.Q:RIEN=0
.S ORPHOI=+$P($G(^ORD(101.41,IEN,6,RIEN,1)),U,1)
.Q:ORPHOI=0
.S ORPHOI=$P($G(^ORD(101.43,ORPHOI,0)),U,2)
.Q:$P(ORPHOI,";",2)'="99PSP"
.D DRGIEN^PSS50P7(+ORPHOI,,"ORSUPPLY")
.Q:+^TMP($J,"ORSUPPLY",0)<1
.S ORDRGIEN=0 F S ORDRGIEN=$O(^TMP($J,"ORSUPPLY",ORDRGIEN)) Q:'+$G(ORDRGIEN)!($G(EXIT))!($G(SET)) D
..D ZERO^PSS50(ORDRGIEN,,,,,"ORDRUG")
..Q:+^TMP($J,"ORDRUG",0)<1
..I $$ISSUPPLY(ORDRGIEN),'$G(SET) D
...;CHANGE THE DISPLAY GROUP
...N FDA,ERROR
...S FDA(101.41,IEN_",",5)=DG("SUPPLY")
...D FILE^DIE("K","FDA","ERROR")
...I $D(ERROR) D Q
....D ERROR("Unable to convert quick order IEN #"_IEN,.ERROR)
....S EXIT=1
...S SET=1
K ^TMP($J,"ORSUPPLY")
Q 1
ISSUPPLY(ORDRGIEN) ;DETERMINE IF DRUG IS A SUPPLY ITEM
;PARAMETERS: ORDRGIEN=>DRUG IEN IN ^TMP($J,"ORDRUG") GLOBAL
Q:"^XA^XX^"[(U_$E(^TMP($J,"ORDRUG",ORDRGIEN,2),1,2)_U)!(^TMP($J,"ORDRUG",ORDRGIEN,2)="DX900"&($G(^TMP($J,"ORDRUG",ORDRGIEN,3))["S")) 1
Q 0
ERROR(TEXT,ERROR) ;OUTPUT FILEMAN ERROR MESSAGE(S)
N ORMSG,IDX
S ORMSG(1)=" "
S ORMSG(2)="ERROR: "_TEXT_"."
S ORMSG(3)="VA FileMan Error #"_ERROR("DIERR",1)_":"
F IDX=1:1:+$O(ERROR("DIERR",1,"TEXT","A"),-1) D
.S ORMSG(IDX+2)=ERROR("DIERR",1,"TEXT",IDX)
D BMES^XPDUTL(.ORMSG)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HORY350A 4560 printed Sep 23, 2025@20:17:46 Page 2
ORY350A ;ISP/JLC,RFR - POST-INSTALL FOR PATCH OR*3.0*350 ;04/27/2015 08:48
+1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**350**;Dec 17, 1997;Build 77
+2 QUIT
SUPPLY ;correct entries in 101.43 and build list of supply
+1 ;entries in 101.44
+2 NEW S1,S2,S3,PSOI,PSVAC,FDA,ORFIEN
+3 KILL ^TMP($JOB,"ORY350A"),^TMP($JOB,"ORY350A1")
+4 SET S1=""
FOR
SET S1=$ORDER(^ORD(101.43,"S.SPLY",S1))
if S1=""
QUIT
Begin DoDot:1
+5 SET S2=0
+6 FOR
SET S2=$ORDER(^ORD(101.43,"S.SPLY",S1,S2))
if 'S2
QUIT
Begin DoDot:2
+7 SET ORFIEN=S2_","
SET PSOI=+$PIECE(^ORD(101.43,S2,0),"^",2)
DO DRGIEN^PSS50P7(PSOI,"","ORY350A")
+8 IF ^TMP($JOB,"ORY350A",0)'>0
QUIT
+9 SET S3=0
+10 FOR
SET S3=$ORDER(^TMP($JOB,"ORY350A",S3))
if 'S3
QUIT
Begin DoDot:3
+11 DO ZERO^PSS50(S3,,,,,"ORY350A1")
+12 IF ^TMP($JOB,"ORY350A1",0)'>0
QUIT
+13 SET PSVAC=$GET(^TMP($JOB,"ORY350A1",S3,2))
SET FDA(101.43,ORFIEN,50.5)=0
+14 IF PSVAC?1"XA".E!(PSVAC?1"XX".E)!(PSVAC="DX900"&($GET(^TMP($JOB,"ORY350A1",S3,3))["S"))
SET FDA(101.43,ORFIEN,50.5)=1
+15 DO FILE^DIE("","FDA")
End DoDot:3
End DoDot:2
End DoDot:1
+16 ;build supply item list for order dialog
+17 DO FVBLDQ^ORWUL("SPLY",1)
+18 QUIT
NOTIFI() ;CREATE NEW NOTIFICATIONS
+1 NEW ORFDA,ORIEN,ORERROR,ENT,PAR,INST,ORERROR,EXIT,ORVALUE
+2 DO MES^XPDUTL(" LAPSED UNSIGNED ORDER")
+3 SET ENT="PKG."_"ORDER ENTRY/RESULTS REPORTING"
SET INST="LAPSED UNSIGNED ORDER"
+4 SET ORVALUE("ORB ARCHIVE PERIOD")=30
+5 SET ORVALUE("ORB DELETE MECHANISM")="Individual Recipient"
+6 SET ORVALUE("ORB FORWARD BACKUP REVIEWER")=0
+7 SET ORVALUE("ORB FORWARD SUPERVISOR")=0
+8 SET ORVALUE("ORB FORWARD SURROGATES")=0
+9 SET ORVALUE("ORB PROCESSING FLAG")="Disabled"
+10 SET ORVALUE("ORB PROVIDER RECIPIENTS")="OAPT"
+11 SET ORVALUE("ORB URGENCY")="High"
+12 SET PAR=""
FOR
SET PAR=$ORDER(ORVALUE(PAR))
if $GET(PAR)=""!($GET(EXIT))
QUIT
Begin DoDot:1
+13 ;ICR #2336
DO EN^XPAR(ENT,PAR,INST,ORVALUE(PAR),.ORERROR)
+14 IF +ORERROR
Begin DoDot:2
+15 SET ORMSG(1)=" "
SET EXIT=1
+16 SET ORMSG(2)="ERROR: Unable to configure the new Lapsed Unsigned Order(s) notification"
+17 SET ORMSG(3)="Kernel Parameter Tools Error #"_+ORERROR_": "_$PIECE(ORERROR,U,2)
+18 DO BMES^XPDUTL(.ORMSG)
End DoDot:2
End DoDot:1
+19 if $GET(EXIT)
QUIT 0
+20 QUIT 1
SQOCONV() ;CONVERT EXISTING OUTPATIENT MEDICATION QUICK ORDERS INTO SUPPLY QUICK ORDERS
+1 NEW DG,DLG,ORTEXT
+2 SET DG("OUT")=$ORDER(^ORD(100.98,"B","OUTPATIENT MEDICATIONS",0))
+3 IF +DG("OUT")=0
Begin DoDot:1
+4 SET ORTEXT(1)="Unable to find the OUTPATIENT MEDICATIONS display group in the DISPLAY GROUP"
+5 SET ORTEXT(2)="file (#100.98). Please log a Remedy ticket for assistance."
+6 DO BMES^XPDUTL(.ORTEXT)
End DoDot:1
QUIT 0
+7 SET DG("SUPPLY")=$ORDER(^ORD(100.98,"B","SUPPLIES/DEVICES",0))
+8 IF +DG("SUPPLY")=0
Begin DoDot:1
+9 SET ORTEXT(1)="Unable to find the SUPPLIES/DEVICES display group in the DISPLAY GROUP file"
+10 SET ORTEXT(2)="(#100.98). Please log a Remedy ticket for assistance."
+11 DO BMES^XPDUTL(.ORTEXT)
End DoDot:1
QUIT 0
+12 SET DLG("ORDERABLE ITEM")=+$ORDER(^ORD(101.41,"B","OR GTX ORDERABLE ITEM",0))
+13 IF DLG("ORDERABLE ITEM")=0
Begin DoDot:1
+14 SET ORTEXT(1)="Unable to find the OR GTX ORDERABLE ITEM dialog in the ORDER DIALOG file"
+15 SET ORTEXT(2)="(#101.41). Please log a Remedy ticket for assistance."
End DoDot:1
QUIT 0
+16 NEW IEN,EXIT
+17 SET IEN=0
FOR
SET IEN=$ORDER(^ORD(101.41,IEN))
if +$GET(IEN)=0!($GET(EXIT))
QUIT
Begin DoDot:1
+18 ;SKIP DISABLED QUICK ORDER (FIELD #3 NOT BLANK)
+19 if $PIECE(^ORD(101.41,IEN,0),U,3)'=""
QUIT
+20 ;SKIP NON-QUICK ORDER
+21 if $PIECE(^ORD(101.41,IEN,0),U,4)'="Q"
QUIT
+22 ;SKIP NON-OUTPATIENT MEDICATIONS
+23 if $PIECE(^ORD(101.41,IEN,0),U,5)'=DG("OUT")
QUIT
+24 ;DETERMINE IF THE ORDERABLE ITEM IS A SUPPLY
+25 NEW RIEN,ORPHOI,ORDRGIEN,SET
+26 SET RIEN=+$ORDER(^ORD(101.41,IEN,6,"D",DLG("ORDERABLE ITEM"),0))
+27 if RIEN=0
QUIT
+28 SET ORPHOI=+$PIECE($GET(^ORD(101.41,IEN,6,RIEN,1)),U,1)
+29 if ORPHOI=0
QUIT
+30 SET ORPHOI=$PIECE($GET(^ORD(101.43,ORPHOI,0)),U,2)
+31 if $PIECE(ORPHOI,";",2)'="99PSP"
QUIT
+32 DO DRGIEN^PSS50P7(+ORPHOI,,"ORSUPPLY")
+33 if +^TMP($JOB,"ORSUPPLY",0)<1
QUIT
+34 SET ORDRGIEN=0
FOR
SET ORDRGIEN=$ORDER(^TMP($JOB,"ORSUPPLY",ORDRGIEN))
if '+$GET(ORDRGIEN)!($GET(EXIT))!($GET(SET))
QUIT
Begin DoDot:2
+35 DO ZERO^PSS50(ORDRGIEN,,,,,"ORDRUG")
+36 if +^TMP($JOB,"ORDRUG",0)<1
QUIT
+37 IF $$ISSUPPLY(ORDRGIEN)
IF '$GET(SET)
Begin DoDot:3
+38 ;CHANGE THE DISPLAY GROUP
+39 NEW FDA,ERROR
+40 SET FDA(101.41,IEN_",",5)=DG("SUPPLY")
+41 DO FILE^DIE("K","FDA","ERROR")
+42 IF $DATA(ERROR)
Begin DoDot:4
+43 DO ERROR("Unable to convert quick order IEN #"_IEN,.ERROR)
+44 SET EXIT=1
End DoDot:4
QUIT
+45 SET SET=1
End DoDot:3
End DoDot:2
End DoDot:1
+46 KILL ^TMP($JOB,"ORSUPPLY")
+47 QUIT 1
ISSUPPLY(ORDRGIEN) ;DETERMINE IF DRUG IS A SUPPLY ITEM
+1 ;PARAMETERS: ORDRGIEN=>DRUG IEN IN ^TMP($J,"ORDRUG") GLOBAL
+2 if "^XA^XX^"[(U_$EXTRACT(^TMP($JOB,"ORDRUG",ORDRGIEN,2),1,2)_U)!(^TMP($JOB,"ORDRUG",ORDRGIEN,2)="DX900"&($GET(^TMP($JOB,"ORDRUG",ORDRGIEN,3))["S"))
QUIT 1
+3 QUIT 0
ERROR(TEXT,ERROR) ;OUTPUT FILEMAN ERROR MESSAGE(S)
+1 NEW ORMSG,IDX
+2 SET ORMSG(1)=" "
+3 SET ORMSG(2)="ERROR: "_TEXT_"."
+4 SET ORMSG(3)="VA FileMan Error #"_ERROR("DIERR",1)_":"
+5 FOR IDX=1:1:+$ORDER(ERROR("DIERR",1,"TEXT","A"),-1)
Begin DoDot:1
+6 SET ORMSG(IDX+2)=ERROR("DIERR",1,"TEXT",IDX)
End DoDot:1
+7 DO BMES^XPDUTL(.ORMSG)
+8 QUIT
