- 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 Feb 19, 2025@00:08:35 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