ORY423A ;ISP/JLC,RFR - POST-INSTALL FOR PATCH OR*3.0*350 ;06/29/16 06:17
;;3.0;ORDER ENTRY/RESULTS REPORTING;**423**;Dec 17, 1997;Build 19
Q
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-SUPPLY
.Q:$P(^ORD(101.41,IEN,0),U,5)'=DG("SUPPLY")
.;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("OUT")
...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[HORY423A 2774 printed Dec 13, 2024@02:42:04 Page 2
ORY423A ;ISP/JLC,RFR - POST-INSTALL FOR PATCH OR*3.0*350 ;06/29/16 06:17
+1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**423**;Dec 17, 1997;Build 19
+2 QUIT
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-SUPPLY
+23 if $PIECE(^ORD(101.41,IEN,0),U,5)'=DG("SUPPLY")
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("OUT")
+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
