Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: ORY423A

ORY423A.m

Go to the documentation of this file.
  1. 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
  1. Q
  1. SQOCONV() ;CONVERT EXISTING OUTPATIENT MEDICATION QUICK ORDERS INTO SUPPLY QUICK ORDERS
  1. N DG,DLG,ORTEXT
  1. S DG("OUT")=$O(^ORD(100.98,"B","OUTPATIENT MEDICATIONS",0))
  1. I +DG("OUT")=0 D Q 0
  1. .S ORTEXT(1)="Unable to find the OUTPATIENT MEDICATIONS display group in the DISPLAY GROUP"
  1. .S ORTEXT(2)="file (#100.98). Please log a Remedy ticket for assistance."
  1. .D BMES^XPDUTL(.ORTEXT)
  1. S DG("SUPPLY")=$O(^ORD(100.98,"B","SUPPLIES/DEVICES",0))
  1. I +DG("SUPPLY")=0 D Q 0
  1. .S ORTEXT(1)="Unable to find the SUPPLIES/DEVICES display group in the DISPLAY GROUP file"
  1. .S ORTEXT(2)="(#100.98). Please log a Remedy ticket for assistance."
  1. .D BMES^XPDUTL(.ORTEXT)
  1. S DLG("ORDERABLE ITEM")=+$O(^ORD(101.41,"B","OR GTX ORDERABLE ITEM",0))
  1. I DLG("ORDERABLE ITEM")=0 D Q 0
  1. .S ORTEXT(1)="Unable to find the OR GTX ORDERABLE ITEM dialog in the ORDER DIALOG file"
  1. .S ORTEXT(2)="(#101.41). Please log a Remedy ticket for assistance."
  1. N IEN,EXIT
  1. S IEN=0 F S IEN=$O(^ORD(101.41,IEN)) Q:+$G(IEN)=0!($G(EXIT)) D
  1. .;SKIP DISABLED QUICK ORDER (FIELD #3 NOT BLANK)
  1. .Q:$P(^ORD(101.41,IEN,0),U,3)'=""
  1. .;SKIP NON-QUICK ORDER
  1. .Q:$P(^ORD(101.41,IEN,0),U,4)'="Q"
  1. .;SKIP NON-SUPPLY
  1. .Q:$P(^ORD(101.41,IEN,0),U,5)'=DG("SUPPLY")
  1. .;DETERMINE IF THE ORDERABLE ITEM IS A SUPPLY
  1. .N RIEN,ORPHOI,ORDRGIEN,SET
  1. .S RIEN=+$O(^ORD(101.41,IEN,6,"D",DLG("ORDERABLE ITEM"),0))
  1. .Q:RIEN=0
  1. .S ORPHOI=+$P($G(^ORD(101.41,IEN,6,RIEN,1)),U,1)
  1. .Q:ORPHOI=0
  1. .S ORPHOI=$P($G(^ORD(101.43,ORPHOI,0)),U,2)
  1. .Q:$P(ORPHOI,";",2)'="99PSP"
  1. .D DRGIEN^PSS50P7(+ORPHOI,,"ORSUPPLY")
  1. .Q:+^TMP($J,"ORSUPPLY",0)<1
  1. .S ORDRGIEN=0 F S ORDRGIEN=$O(^TMP($J,"ORSUPPLY",ORDRGIEN)) Q:'+$G(ORDRGIEN)!($G(EXIT))!($G(SET)) D
  1. ..D ZERO^PSS50(ORDRGIEN,,,,,"ORDRUG")
  1. ..Q:+^TMP($J,"ORDRUG",0)<1
  1. ..I $$ISSUPPLY(ORDRGIEN),'$G(SET) D
  1. ...;CHANGE THE DISPLAY GROUP
  1. ...N FDA,ERROR
  1. ...S FDA(101.41,IEN_",",5)=DG("OUT")
  1. ...D FILE^DIE("K","FDA","ERROR")
  1. ...I $D(ERROR) D Q
  1. ....D ERROR("Unable to convert quick order IEN #"_IEN,.ERROR)
  1. ....S EXIT=1
  1. ...S SET=1
  1. K ^TMP($J,"ORSUPPLY")
  1. Q 1
  1. ISSUPPLY(ORDRGIEN) ;DETERMINE IF DRUG IS A SUPPLY ITEM
  1. ;PARAMETERS: ORDRGIEN=>DRUG IEN IN ^TMP($J,"ORDRUG") GLOBAL
  1. 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
  1. Q 0
  1. ERROR(TEXT,ERROR) ;OUTPUT FILEMAN ERROR MESSAGE(S)
  1. N ORMSG,IDX
  1. S ORMSG(1)=" "
  1. S ORMSG(2)="ERROR: "_TEXT_"."
  1. S ORMSG(3)="VA FileMan Error #"_ERROR("DIERR",1)_":"
  1. F IDX=1:1:+$O(ERROR("DIERR",1,"TEXT","A"),-1) D
  1. .S ORMSG(IDX+2)=ERROR("DIERR",1,"TEXT",IDX)
  1. D BMES^XPDUTL(.ORMSG)
  1. Q