source: FOIAVistA/trunk/r/ORDER_ENTRY_RESULTS_REPORTING-OR-OCX--ORRC--ORRJ/ORCONV1.m@ 1397

ORCONV1 ; SLC/MKB - Convert protocols/menus to Dialogs cont ;6/10/97  10:37
 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**14**;Dec 17, 1997
EN ; -- process pkg quick order PITEM from $$ITEM
 I '$L(NMSP) G UNKPKG^ORCONVRT
 G:$L($T(@NMSP)) @NMSP
 S NMSP=$E(NMSP,1,4) G:$L($T(@NMSP)) @NMSP
 S NMSP=$E(NMSP,1,2) G:$L($T(@NMSP)) @NMSP
 G UNKPKG^ORCONVRT
 Q
 ;
OR ; -- Generic text orders
 I TYPE'="A" G OR^ORCONV0
 Q
 ;
SR ; -- Surgery
GMRA ; -- Allergies
 Q
 ;
FH ; -- Dietetics
 I TYPE'="A" G FH^ORCONV2
 Q
 ;
GMRC ; -- Consults
 Q:TYPE="A"  N DEFAULT,FLINK,ORDG,OI,X,CNT,CODE,Z,ZZ,PKG
 I NAME?1"GMRCT".E D  G GMRC1
 . S DEFAULT="CONSULT",ORDG=$O(^ORD(100.98,"B","CSLT",0))
 . S FLINK=+$P($G(^ORD(101,PITEM,5)),U)_";99CON"
 I NAME?1"GMRCR".E D  G GMRC1
 . S DEFAULT="REQUEST",ORDG=$O(^ORD(100.98,"B","PROC",0))
 . S FLINK=PITEM_";99PRO"
 G NONSTD^ORCONVRT
GMRC1 S DEFAULT=$O(^ORD(101.41,"AB","GMRCOR "_DEFAULT,0)) G:'DEFAULT NONSTD^ORCONVRT
 S OI=$O(^ORD(101.43,"ID",FLINK,0)) G:'OI OI^ORCONVRT
 S DITEM=$$DIALOG^ORCONVRT(PITEM) G:'DITEM DLG^ORCONVRT
 S PKG=$O(^DIC(9.4,"C","GMRC",0))
 S X=^ORD(101.41,DITEM,0),X=X_"^^Q^"_ORDG_U_$S('+$G(^ORD(101,PITEM,101.01)):2,1:0)_U_PKG_"^0^0",^ORD(101.41,DITEM,0)=X
 S:PKG ^ORD(101.41,"APKG",+PKG,DITEM)=""
 K ^ORD(101.41,DITEM,6) S CODE=$G(^ORD(101,PITEM,20))
 D SET^ORCONVRT("ORDERABLE ITEM",OI)
 S Z=$F(CODE,"GMRCFIO=") I Z S ZZ=$$VALUE^ORCONVRT(CODE,Z) D SET^ORCONVRT("CATEGORY",ZZ)
 S Z=$F(CODE,"GMRCURGX=") I Z S Z=+$E(CODE,Z,999),ZZ=$P($P($G(^ORD(101,Z,0)),U)," - ",2),ZZ=+$O(^ORD(101.42,"B",ZZ,0)) D:ZZ SET^ORCONVRT("URGENCY",ZZ)
 S Z=$F(CODE,"GMRCPLZ=") I Z S ZZ=$$VALUE^ORCONVRT(CODE,Z),ZZ=$S(ZZ="Bedside":"B",ZZ="Consultant's Choice":"C",ZZ="Emergency Room":"E",1:"") D:$L(ZZ) SET^ORCONVRT("PLACE OF CONSULTATION",ZZ)
 S ZZ="" I $O(^ORD(101,PITEM,101.0431,0)) S Z="^ORD(101,"_PITEM_",101.0431)" D SET^ORCONVRT("WORD PROCESSING 1",Z) S:$F(CODE,"GMRCREAF=") ZZ="S GMRCREAF=1"
 S:$F(CODE,"GMRCNOPD=") ZZ=ZZ_$S($L(ZZ):",",1:"S ")_"GMRCNOPD=1"
 S:$F(CODE,"GMRCNOAT=") ZZ=ZZ_$S($L(ZZ):",",1:"S ")_"GMRCNOAT=1"
 S:$L(ZZ) ^ORD(101.41,DITEM,3)=ZZ ; entry action
 S:$G(CNT) ^ORD(101.41,DITEM,6,0)="^101.416^"_CNT_U_CNT
 Q
 ;
GMRV ; -- Vitals
 ; default Vitals dialog = GMRVOR
 Q:TYPE="A"  N DEFAULT,VALUE,OI,TEXT,Z,CODE,START,STOP,SCH,X,CNT,PKG
 S TEXT=$P(^ORD(101,PITEM,0),U,2),CODE=$G(^(20)),VALUE="NOW^^"
 I NAME?1"GMRVORQ"1.N D  Q:'Z  ;quick order
 . S:$E(TEXT,1,6)="QUICK " TEXT=$E(TEXT,7,999)
 . S Z=$F(CODE,"GMRVANSR=") I 'Z D NONSTD^ORCONVRT Q
 . S VALUE=$P($E(CODE,Z,999),"""",2)
 S Z=$O(^ORD(100.98,"B","V/M",0))_"^V/M",OI=$$ORDITM^ORCONV0(TEXT,Z)
 G:'OI OI^ORCONVRT G:$$INACTIVE^ORCONVRT(OI) OI^ORCONVRT
 S DITEM=$$DIALOG^ORCONVRT(PITEM) G:'DITEM DLG^ORCONVRT
 S DEFAULT=+$O(^ORD(101.41,"AB","GMRVOR",0))
 S PKG=+$O(^DIC(9.4,"C","GMRV",0))
 S X=^ORD(101.41,DITEM,0),X=X_"^^Q^"_$P(^ORD(101.41,DEFAULT,0),U,5)_U_$S('+$G(^ORD(101,PITEM,101.01)):2,1:0)_U_PKG_"^0^0",^ORD(101.41,DITEM,0)=X
 S:PKG ^ORD(101.41,"APKG",+PKG,DITEM)=""
 S START=$P(VALUE,U),STOP=$P(VALUE,U,2),SCH=$P(VALUE,U,3)
 F Z="START","STOP","SCH" I $E(@Z)="~" S @Z=$E(@Z,2,99) ; strip leading ~
 K ^ORD(101.41,DITEM,6) D SET^ORCONVRT("ORDERABLE ITEM",OI)
 D:$L(START) SET^ORCONVRT("START DATE/TIME",START)
 D:$L(STOP) SET^ORCONVRT("STOP DATE/TIME",STOP)
 D:$L(SCH) SET^ORCONVRT("SCHEDULE",SCH)
 S:$G(CNT) ^ORD(101.41,DITEM,6,0)="^101.416^"_CNT_U_CNT
 Q
 ;
LR ; -- Lab
 I TYPE'="A" G LR^ORCONV2
 Q
 ;
PS ; -- Pharmacy
 Q:TYPE="A"  G:NAME'?1"PSJQ".E NONSTD^ORCONVRT K ^TMP("PSJQO",$J)
 D EN^PSSQOC(PITEM) G:'$D(^TMP("PSJQO",$J)) UNABLE^ORCONVRT
 S TYPE=$P($G(^TMP("PSJQO",$J,1)),U,2)
 G IV^ORCONV2:TYPE=1,UD^ORCONV2:TYPE=2
 G UNABLE^ORCONVRT ; unable to map OI/Drug/IV rate or volume
 Q
 ;
RA ; -- Radiology
 ; default Radiology Order dialog = RA OERR EXAM
 N DEFAULT,FLINK,CODE,OI,X,Y,Z,ZZ,MODS,DFLT,IMTYPE,INST,ORDG,CNT,PKG
 Q:TYPE="A"  ; G:NAME'?1"RA"1.N.E NONSTD^ORCONVRT ; not a quick order
 S FLINK=+$P($G(^ORD(101,PITEM,5)),U)_";99RAP",CODE=$G(^(20))
 S OI=$O(^ORD(101.43,"ID",FLINK,0))
 G:'OI OI^ORCONVRT G:$$INACTIVE^ORCONVRT(OI) OI^ORCONVRT
 S IMTYPE=$P($G(^ORD(101.43,OI,"RA")),U,3)
 S ORDG=$O(^ORD(100.98,"B",IMTYPE,0)) S:'ORDG ORDG=$O(^ORD(100.98,"B","XRAY",0))
 S DITEM=$$DIALOG^ORCONVRT(PITEM) G:'DITEM DLG^ORCONVRT
 S DEFAULT=$O(^ORD(101.41,"AB","RA OERR EXAM",0)),PKG=$O(^DIC(9.4,"C","RA",0))
 S X=^ORD(101.41,DITEM,0),X=X_"^^Q^"_ORDG_U_$S('+$G(^ORD(101,PITEM,101.01)):2,1:0)_U_PKG_"^0^0",^ORD(101.41,DITEM,0)=X
 S:PKG ^ORD(101.41,"APKG",+PKG,DITEM)=""
 K ^ORD(101.41,DITEM,6)
RA1 ; Stuff values for quick order into appropriate prompts
 D SET^ORCONVRT("ORDERABLE ITEM",OI)
 S Z=$F(CODE,"RAILOC=") I Z S ZZ=+$E(CODE,Z,999) D:ZZ&$D(^RA(79.1,ZZ,0)) SET^ORCONVRT("IMAGING LOCATION",ZZ)
 S Z=$F(CODE,"RARU=") I Z S ZZ=+$E(CODE,Z,999) D:ZZ&$D(^ORD(101.42,ZZ,0)) SET^ORCONVRT("URGENCY",ZZ)
 S Z=$F(CODE,"RACAT=") I Z S ZZ=$$VALUE^ORCONVRT(CODE,Z) D:$L(ZZ) SET^ORCONVRT("CATEGORY",ZZ)
 S Z=$F(CODE,"RAREQDT=") I Z S ZZ=$$VALUE^ORCONVRT(CODE,Z) D:$L(ZZ) SET^ORCONVRT("START DATE/TIME",ZZ)
 S Z=$F(CODE,"RAMT=") I Z S ZZ=$$VALUE^ORCONVRT(CODE,Z),ZZ=$$UP^XLFSTR(ZZ) D:$L(ZZ) SET^ORCONVRT("MODE OF TRANSPORT",ZZ)
RA2 ; Skip RAIP - look for generic order instead
 G RAQ:CODE'["RAMOD" ; no modifiers
 S MODS=CODE,INST=0 F  S Z=$F(MODS,"RAMOD(") Q:'Z  D
 . S MODS=$E(MODS,Z,999),X=+$P(MODS,"=",2)
 . I X,$D(^RAMIS(71.2,X,0)) S INST=INST+1 D SET^ORCONVRT("MODIFIERS",X,INST)
RAQ S:$G(CNT) ^ORD(101.41,DITEM,6,0)="^101.416^"_CNT_U_CNT
 Q
 ;
DG ; -- Registration
SD ; -- Scheduling
 I TYPE'="A",TYPE'="O" Q  ; actions or protocols only
 N X,PKG S DITEM=$$DIALOG^ORCONVRT(PITEM) G:'DITEM DLG^ORCONVRT
 S PKG=$P(^ORD(101,PITEM,0),U,12)
 S X=^ORD(101.41,DITEM,0),X=X_"^^A^"_$O(^ORD(100.98,"B","M.A.S.",0))_U_U_PKG,^ORD(101.41,DITEM,0)=X
 S:PKG ^ORD(101.41,"APKG",+PKG,DITEM)=""
 S ^ORD(101.41,DITEM,3)="D SAVE^ORXD"_$S($L($G(^ORD(101,PITEM,20))):" "_^(20),1:"")
 S ^ORD(101.41,DITEM,4)=$S($L($G(^ORD(101,PITEM,15))):^(15)_" ",1:"")_"D RSTR^ORXD"
 Q