source: FOIAVistA/tag/r/ORDER_ENTRY_RESULTS_REPORTING-OR-OCX--ORRC--ORRJ/ORCONV2.m@ 636

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

initial load of FOIAVistA 6/30/08 version
File size: 5.8 KB
Line 
1ORCONV2 ; SLC/MKB - Convert protocols/menus to Dialogs cont ;6/10/97 10:40
2 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**14**;Dec 17, 1997
3FH ; -- process Diet PITEM
4 ; default Diet Order dialog = FHW1
5 N DEFAULT,DIETS,CODE,Z,X,Y,OI,DFLT,I,QUOTE,ERR,INST,CNT,PKG
6 I NAME="FHW5" S DITEM=$O(^ORD(101.41,"AB","GMRAOR ALLERGY ENTER/EDIT",0)) Q
7 I NAME="FHW6" S DITEM=$O(^ORD(101.41,"AB","GMRCOR CONSULT",0)) Q
8 ; G:NAME'?1"FHWD"1.N NONSTD^ORCONVRT ; not a quick order
9 S CODE=$G(^ORD(101,PITEM,20)),Z=$F(CODE,"FHOR=")
10 S:'Z CODE="S FHOR="_+$E(NAME,5,99),Z=7
11 S DIETS=$E(CODE,Z,999),DIETS=$P(DIETS," "),QUOTE=""""
12 S:$E(DIETS)=QUOTE DIETS=$P(DIETS,QUOTE,2) ; ="#^^^^"
13 S DITEM=$$DIALOG^ORCONVRT(PITEM) G:'DITEM DLG^ORCONVRT
14 S DEFAULT=$O(^ORD(101.41,"AB","FHW1",0)),PKG=$O(^DIC(9.4,"C","FH",0))
15 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
16 S:PKG ^ORD(101.41,"APKG",+PKG,DITEM)=""
17 K ^ORD(101.41,DITEM,6)
18FH1 ; save diet(s) into DIET prompt
19 S INST=0 F I=1:1:$L(DIETS,"^") S X=$P(DIETS,U,I) I X D
20 . S OI=$O(^ORD(101.43,"ID",X_";99FHD",0)) I 'OI S ERR=1 Q
21 . I $$INACTIVE^ORCONVRT(OI) S ERR=1 Q
22 . S INST=INST+1 D SET^ORCONVRT("ORDERABLE ITEM",OI,INST)
23 S:$G(CNT) ^ORD(101.41,DITEM,6,0)="^101.416^"_CNT_U_CNT
24 G:$G(ERR) OI^ORCONVRT ; incomplete OI's
25 Q
26 ;
27LR ; -- process Lab PITEM
28 ; default Lab Order dialog = LR OTHER LAB TESTS
29 N DEFAULT,IFN,OI,SAMP,SPEC,DA,CODE,Z,ZZ,X,CNT,PKG
30 I TYPE="L" S OI=$$LRTEST(PITEM) G LR1
31 S DA=0 F S DA=$O(^ORD(101,PITEM,10,DA)) Q:DA'>0 S IFN=+$P(^(DA,0),U) D
32 . N NAME,FLINK S NAME=$P($G(^ORD(101,IFN,0)),U),FLINK=$P($G(^(5)),U)
33 . I NAME?1"LR ".E,FLINK?1.N1";LAB(60," S OI=$$LRTEST(IFN)
34 . I NAME?1"LRD ".E,FLINK?1.N1";LAB(62," S SAMP=+FLINK
35 . I NAME?1"LRS ".E,FLINK?1.N1";LAB(61," S SPEC=+FLINK
36LR1 G:'$D(OI) NONSTD^ORCONVRT
37 G:'OI OI^ORCONVRT G:$$INACTIVE^ORCONVRT(OI) OI^ORCONVRT
38 S DITEM=$$DIALOG^ORCONVRT(PITEM) G:'DITEM DLG^ORCONVRT
39 K ^ORD(101.41,DITEM,6) S PKG=$O(^DIC(9.4,"C","LR",0))
40 S DEFAULT=$O(^ORD(101.41,"AB","LR OTHER LAB TESTS",0))
41 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
42 S:PKG ^ORD(101.41,"APKG",+PKG,DITEM)=""
43 D SET^ORCONVRT("ORDERABLE ITEM",OI) S CODE=$G(^ORD(101,PITEM,20))
44 D I $G(SAMP) D SET^ORCONVRT("COLLECTION SAMPLE",SAMP)
45 . I '$G(SAMP) S Z=$F(CODE,"LRFSAMP=") S:Z SAMP=+$$VALUE^ORCONVRT(CODE,Z)
46 . K:'$D(^LAB(62,+$G(SAMP),0)) SAMP
47 D I $G(SPEC) D SET^ORCONVRT("SPECIMEN",SPEC)
48 . I '$G(SPEC) S Z=$F(CODE,"LRFSPEC=") S:Z SPEC=$$VALUE^ORCONVRT(CODE,Z)
49 . K:'$D(^LAB(61,+$G(SPEC),0)) SPEC
50 S Z=$F(CODE,"LRFZX=") I Z S ZZ=$$VALUE^ORCONVRT(CODE,Z) D SET^ORCONVRT("COLLECTION TYPE",ZZ)
51 S Z=$F(CODE,"LRFURG=") I Z S ZZ=+$E(CODE,Z,999) D:ZZ SET^ORCONVRT("LAB URGENCY",ZZ)
52LR2 S Z=$F(CODE,"LRFDATE=") I Z D D SET^ORCONVRT("START DATE/TIME",ZZ):$L(ZZ),STRTDT^ORCONVRT:'$L(ZZ)
53 . N X,Y,%DT,X1,X2
54 . S X=$$VALUE^ORCONVRT(CODE,Z),ZZ="" Q:'$L(X) S:X="DT" X="TODAY"
55 . I X="%",CODE["NOW^%DTC" S X="NOW"
56 . S:X="$$NOW^XLFDT" X="NOW" S:X="$$DT^XLFDT" X="TODAY"
57 . I X="X",CODE["C^%DTC" S X1=$F(CODE,"X1=") Q:'X1 S X1=$$VALUE^ORCONVRT(CODE,X1) Q:'$S(X1="DT":1,X1="$$DT^XLFDT":1,1:0) S X2=$F(CODE,"X2=") Q:'X2 S X2=$$VALUE^ORCONVRT(CODE,X2) S:X2>0 X="T+"_(+X2)
58 . S %DT="FTX" D ^%DT S:Y>0 ZZ=X ; valid
59 S:$G(CNT) ^ORD(101.41,DITEM,6,0)="^101.416^"_CNT_U_CNT
60 Q
61 ;
62LRTEST(TEST) ; -- Returns Orderable Item ptr for protocol TEST
63 N PTR,OI
64 S PTR=+$G(^ORD(101,TEST,5)),OI=$O(^ORD(101.43,"ID",PTR_";99LRT",0))
65 Q +OI
66 ;
67IV ; -- process IV med PITEM
68 N DEFAULT,X,INST,OI,ADD,SOL,RATE,ARRAY,CNT,PROVCOMM,PKG
69 S DEFAULT=$O(^ORD(101.41,"AB","PSJI OR PAT FLUID OE",0)),PKG=$O(^DIC(9.4,"C","PSIV",0))
70 S DITEM=$$DIALOG^ORCONVRT(PITEM) G:'DITEM DLG^ORCONVRT
71 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
72 S:PKG ^ORD(101.41,"APKG",+PKG,DITEM)=""
73 S INST=0 F S INST=$O(^TMP("PSJQO",$J,"SOL",INST)) Q:INST'>0 S SOL=$G(^(INST,0)) D
74 . S OI=$O(^ORD(101.43,"ID",$P(SOL,U)_";99PSP",0)) Q:'OI
75 . D SET^ORCONVRT("ORDERABLE ITEM",OI,INST)
76 . D SET^ORCONVRT("VOLUME",+$P(SOL,U,2),INST)
77 S INST=0 F S INST=$O(^TMP("PSJQO",$J,"AD",INST)) Q:INST'>0 S ADD=$G(^(INST,0)) D
78 . S OI=$O(^ORD(101.43,"ID",$P(ADD,U)_";99PSP",0)) Q:'OI
79 . D SET^ORCONVRT("ADDITIVE",OI,INST)
80 . D SET^ORCONVRT("STRENGTH PSIV",$P(ADD,U,2),INST)
81 . D SET^ORCONVRT("UNITS",$P(ADD,U,3),INST)
82 S RATE=$P(^TMP("PSJQO",$J,1),U,7),PROVCOMM=$P(^(1),U,8)
83 D:$L(RATE) SET^ORCONVRT("INFUSION RATE",RATE)
84 S:PROVCOMM ^ORD(101.41,DITEM,3)="S PSJNOPC=1"
85 I $G(^TMP("PSJQO",$J,"PC",0)) D ; comments
86 . S X=^TMP("PSJQO",$J,"PC",0),X="^^"_X_U_DT_U,^(0)=X
87 . S ARRAY="^TMP(""PSJQO"","_$J_",""PC"")"
88 . D SET^ORCONVRT("WORD PROCESSING 1",ARRAY)
89 S:$G(CNT) ^ORD(101.41,DITEM,6,0)="^101.416^"_CNT_U_CNT
90 Q
91 ;
92UD ; -- process Unit Dose PITEM
93 N DEFAULT,X,PSOI,OI,ARRAY,CNT,PKG
94 S DEFAULT=$O(^ORD(101.41,"AB","PSJ OR PAT OE",0)),PKG=$O(^DIC(9.4,"C","PSJ",0))
95 S DITEM=$$DIALOG^ORCONVRT(PITEM) G:'DITEM DLG^ORCONVRT
96 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
97 S:PKG ^ORD(101.41,"APKG",+PKG,DITEM)=""
98 S X=$G(^TMP("PSJQO",$J,1)),PSOI=$P(X,U,3),CNT=0
99 I PSOI S OI=$O(^ORD(101.43,"ID",PSOI_";99PSP",0)) I OI G:$$INACTIVE^ORCONVRT(OI) OI^ORCONVRT D SET^ORCONVRT("ORDERABLE ITEM",OI)
100 I +$G(^TMP("PSJQO",$J,"DD")) D SET^ORCONVRT("DISPENSE DRUG",^("DD"))
101 D:$L($P(X,U,6)) SET^ORCONVRT("INSTRUCTIONS",$P(X,U,6))
102 D:$P(X,U,4) SET^ORCONVRT("ROUTE",$P(X,U,4))
103 D:$L($P(X,U,5)) SET^ORCONVRT("SCHEDULE",$P(X,U,5))
104 I $P(X,U,8) S ^ORD(101.41,DITEM,3)="S PSJNOPC=1"
105 I $G(^TMP("PSJQO",$J,"PC",0)) D ; comments
106 . S X=^TMP("PSJQO",$J,"PC",0),X="^^"_X_U_DT_U,^(0)=X
107 . S ARRAY="^TMP(""PSJQO"","_$J_",""PC"")"
108 . D SET^ORCONVRT("WORD PROCESSING 1",ARRAY)
109 S:$G(CNT) ^ORD(101.41,DITEM,6,0)="^101.416^"_CNT_U_CNT
110 Q
Note: See TracBrowser for help on using the repository browser.