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

Last change on this file since 1607 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 5.8 KB
Line 
1ORCONV1 ; SLC/MKB - Convert protocols/menus to Dialogs cont ;6/10/97 10:37
2 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**14**;Dec 17, 1997
3EN ; -- process pkg quick order PITEM from $$ITEM
4 I '$L(NMSP) G UNKPKG^ORCONVRT
5 G:$L($T(@NMSP)) @NMSP
6 S NMSP=$E(NMSP,1,4) G:$L($T(@NMSP)) @NMSP
7 S NMSP=$E(NMSP,1,2) G:$L($T(@NMSP)) @NMSP
8 G UNKPKG^ORCONVRT
9 Q
10 ;
11OR ; -- Generic text orders
12 I TYPE'="A" G OR^ORCONV0
13 Q
14 ;
15SR ; -- Surgery
16GMRA ; -- Allergies
17 Q
18 ;
19FH ; -- Dietetics
20 I TYPE'="A" G FH^ORCONV2
21 Q
22 ;
23GMRC ; -- Consults
24 Q:TYPE="A" N DEFAULT,FLINK,ORDG,OI,X,CNT,CODE,Z,ZZ,PKG
25 I NAME?1"GMRCT".E D G GMRC1
26 . S DEFAULT="CONSULT",ORDG=$O(^ORD(100.98,"B","CSLT",0))
27 . S FLINK=+$P($G(^ORD(101,PITEM,5)),U)_";99CON"
28 I NAME?1"GMRCR".E D G GMRC1
29 . S DEFAULT="REQUEST",ORDG=$O(^ORD(100.98,"B","PROC",0))
30 . S FLINK=PITEM_";99PRO"
31 G NONSTD^ORCONVRT
32GMRC1 S DEFAULT=$O(^ORD(101.41,"AB","GMRCOR "_DEFAULT,0)) G:'DEFAULT NONSTD^ORCONVRT
33 S OI=$O(^ORD(101.43,"ID",FLINK,0)) G:'OI OI^ORCONVRT
34 S DITEM=$$DIALOG^ORCONVRT(PITEM) G:'DITEM DLG^ORCONVRT
35 S PKG=$O(^DIC(9.4,"C","GMRC",0))
36 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
37 S:PKG ^ORD(101.41,"APKG",+PKG,DITEM)=""
38 K ^ORD(101.41,DITEM,6) S CODE=$G(^ORD(101,PITEM,20))
39 D SET^ORCONVRT("ORDERABLE ITEM",OI)
40 S Z=$F(CODE,"GMRCFIO=") I Z S ZZ=$$VALUE^ORCONVRT(CODE,Z) D SET^ORCONVRT("CATEGORY",ZZ)
41 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)
42 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)
43 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"
44 S:$F(CODE,"GMRCNOPD=") ZZ=ZZ_$S($L(ZZ):",",1:"S ")_"GMRCNOPD=1"
45 S:$F(CODE,"GMRCNOAT=") ZZ=ZZ_$S($L(ZZ):",",1:"S ")_"GMRCNOAT=1"
46 S:$L(ZZ) ^ORD(101.41,DITEM,3)=ZZ ; entry action
47 S:$G(CNT) ^ORD(101.41,DITEM,6,0)="^101.416^"_CNT_U_CNT
48 Q
49 ;
50GMRV ; -- Vitals
51 ; default Vitals dialog = GMRVOR
52 Q:TYPE="A" N DEFAULT,VALUE,OI,TEXT,Z,CODE,START,STOP,SCH,X,CNT,PKG
53 S TEXT=$P(^ORD(101,PITEM,0),U,2),CODE=$G(^(20)),VALUE="NOW^^"
54 I NAME?1"GMRVORQ"1.N D Q:'Z ;quick order
55 . S:$E(TEXT,1,6)="QUICK " TEXT=$E(TEXT,7,999)
56 . S Z=$F(CODE,"GMRVANSR=") I 'Z D NONSTD^ORCONVRT Q
57 . S VALUE=$P($E(CODE,Z,999),"""",2)
58 S Z=$O(^ORD(100.98,"B","V/M",0))_"^V/M",OI=$$ORDITM^ORCONV0(TEXT,Z)
59 G:'OI OI^ORCONVRT G:$$INACTIVE^ORCONVRT(OI) OI^ORCONVRT
60 S DITEM=$$DIALOG^ORCONVRT(PITEM) G:'DITEM DLG^ORCONVRT
61 S DEFAULT=+$O(^ORD(101.41,"AB","GMRVOR",0))
62 S PKG=+$O(^DIC(9.4,"C","GMRV",0))
63 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
64 S:PKG ^ORD(101.41,"APKG",+PKG,DITEM)=""
65 S START=$P(VALUE,U),STOP=$P(VALUE,U,2),SCH=$P(VALUE,U,3)
66 F Z="START","STOP","SCH" I $E(@Z)="~" S @Z=$E(@Z,2,99) ; strip leading ~
67 K ^ORD(101.41,DITEM,6) D SET^ORCONVRT("ORDERABLE ITEM",OI)
68 D:$L(START) SET^ORCONVRT("START DATE/TIME",START)
69 D:$L(STOP) SET^ORCONVRT("STOP DATE/TIME",STOP)
70 D:$L(SCH) SET^ORCONVRT("SCHEDULE",SCH)
71 S:$G(CNT) ^ORD(101.41,DITEM,6,0)="^101.416^"_CNT_U_CNT
72 Q
73 ;
74LR ; -- Lab
75 I TYPE'="A" G LR^ORCONV2
76 Q
77 ;
78PS ; -- Pharmacy
79 Q:TYPE="A" G:NAME'?1"PSJQ".E NONSTD^ORCONVRT K ^TMP("PSJQO",$J)
80 D EN^PSSQOC(PITEM) G:'$D(^TMP("PSJQO",$J)) UNABLE^ORCONVRT
81 S TYPE=$P($G(^TMP("PSJQO",$J,1)),U,2)
82 G IV^ORCONV2:TYPE=1,UD^ORCONV2:TYPE=2
83 G UNABLE^ORCONVRT ; unable to map OI/Drug/IV rate or volume
84 Q
85 ;
86RA ; -- Radiology
87 ; default Radiology Order dialog = RA OERR EXAM
88 N DEFAULT,FLINK,CODE,OI,X,Y,Z,ZZ,MODS,DFLT,IMTYPE,INST,ORDG,CNT,PKG
89 Q:TYPE="A" ; G:NAME'?1"RA"1.N.E NONSTD^ORCONVRT ; not a quick order
90 S FLINK=+$P($G(^ORD(101,PITEM,5)),U)_";99RAP",CODE=$G(^(20))
91 S OI=$O(^ORD(101.43,"ID",FLINK,0))
92 G:'OI OI^ORCONVRT G:$$INACTIVE^ORCONVRT(OI) OI^ORCONVRT
93 S IMTYPE=$P($G(^ORD(101.43,OI,"RA")),U,3)
94 S ORDG=$O(^ORD(100.98,"B",IMTYPE,0)) S:'ORDG ORDG=$O(^ORD(100.98,"B","XRAY",0))
95 S DITEM=$$DIALOG^ORCONVRT(PITEM) G:'DITEM DLG^ORCONVRT
96 S DEFAULT=$O(^ORD(101.41,"AB","RA OERR EXAM",0)),PKG=$O(^DIC(9.4,"C","RA",0))
97 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
98 S:PKG ^ORD(101.41,"APKG",+PKG,DITEM)=""
99 K ^ORD(101.41,DITEM,6)
100RA1 ; Stuff values for quick order into appropriate prompts
101 D SET^ORCONVRT("ORDERABLE ITEM",OI)
102 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)
103 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)
104 S Z=$F(CODE,"RACAT=") I Z S ZZ=$$VALUE^ORCONVRT(CODE,Z) D:$L(ZZ) SET^ORCONVRT("CATEGORY",ZZ)
105 S Z=$F(CODE,"RAREQDT=") I Z S ZZ=$$VALUE^ORCONVRT(CODE,Z) D:$L(ZZ) SET^ORCONVRT("START DATE/TIME",ZZ)
106 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)
107RA2 ; Skip RAIP - look for generic order instead
108 G RAQ:CODE'["RAMOD" ; no modifiers
109 S MODS=CODE,INST=0 F S Z=$F(MODS,"RAMOD(") Q:'Z D
110 . S MODS=$E(MODS,Z,999),X=+$P(MODS,"=",2)
111 . I X,$D(^RAMIS(71.2,X,0)) S INST=INST+1 D SET^ORCONVRT("MODIFIERS",X,INST)
112RAQ S:$G(CNT) ^ORD(101.41,DITEM,6,0)="^101.416^"_CNT_U_CNT
113 Q
114 ;
115DG ; -- Registration
116SD ; -- Scheduling
117 I TYPE'="A",TYPE'="O" Q ; actions or protocols only
118 N X,PKG S DITEM=$$DIALOG^ORCONVRT(PITEM) G:'DITEM DLG^ORCONVRT
119 S PKG=$P(^ORD(101,PITEM,0),U,12)
120 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
121 S:PKG ^ORD(101.41,"APKG",+PKG,DITEM)=""
122 S ^ORD(101.41,DITEM,3)="D SAVE^ORXD"_$S($L($G(^ORD(101,PITEM,20))):" "_^(20),1:"")
123 S ^ORD(101.41,DITEM,4)=$S($L($G(^ORD(101,PITEM,15))):^(15)_" ",1:"")_"D RSTR^ORXD"
124 Q
Note: See TracBrowser for help on using the repository browser.