source: FOIAVistA/trunk/r/ORDER_ENTRY_RESULTS_REPORTING-OR-OCX--ORRC--ORRJ/ORY94.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: 7.2 KB
Line 
1ORY94 ;SLC/MKB -- post-install for OR*3*94;02:56 PM 8 May 2001
2 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**94**;Dec 17, 1997
3 ;
4PRE ; -- preinit for patch 94
5 I $O(^ORD(101.41,"AB","PS MEDS",0)) Q ;not first install
6 N ORNOW S ORNOW=$$NOW^XLFDT
7 S ^XTMP("OR94",0)=$$FMADD^XLFDT(ORNOW,90)_U_ORNOW_"^OR*3*94 Conversion"
8 S ^XTMP("OR94","DUZ")=DUZ,^("DLG")=0,^("PAT")=""
9 K ^XTMP("ORPSO"),^XTMP("ORIT"),^XTMP("ORDER")
10 Q
11 ;
12EN ; -- postinit for patch 94
13 N NAME,DLG,ITM,PTR
14 F NAME="PS MEDS","PSJ OR PAT OE","PSO OERR","PSO SUPPLY" D
15 . S DLG=+$O(^ORD(101.41,"AB",NAME,0)) Q:DLG'>0
16 . S PTR=+$$PTR("DRUG NAME") F ITM="ORDERABLE ITEM","STRENGTH" D
17 .. S ITM=+$$PTR(ITM),ITM=+$O(^ORD(101.41,DLG,10,"D",ITM,0))
18 .. I ITM,PTR S $P(^ORD(101.41,DLG,10,ITM,2),U,2)="@"_PTR
19 D ID,DLGS
20 Q
21 ;
22ID ; -- Look for OI's with duplicate ID's, inactivate extras
23 N ORID,ORNOW,DA,DR,DIE S ORNOW=+$E($$NOW^XLFDT,1,12)
24 S ORID="" F S ORID=$O(^ORD(101.43,"ID",ORID)) Q:ORID="" D
25 . S DA=$O(^ORD(101.43,"ID",ORID,0)) Q:'$O(^(DA)) ;no dup's
26 . F S DA=$O(^ORD(101.43,"ID",ORID,DA)) Q:DA'>0 D
27 .. I $G(^ORD(101.43,DA,.1)),^(.1)<ORNOW Q ;already inactive
28 .. S DIE="^ORD(101.43,",DR=".1////"_ORNOW D ^DIE
29 Q
30 ;
31DLGS ; -- Look for local PS dialogs that will need to be updated
32 N PSJ,PSO,ORPKG,ORDLG,OR0,ORZ,CNT
33 S PSJ=+$O(^DIC(9.4,"C","PSJ",0)),PSO=+$O(^DIC(9.4,"C","PSO",0))
34 S ORZ(1)="The order dialogs for medications, PSJ OR PAT OE and PSO OERR, have been"
35 S ORZ(2)="modified in this patch; please review and compare the following local"
36 S ORZ(3)="copies of these dialogs for changes:",CNT=3
37 F ORPKG=PSJ,PSO S ORDLG=0 D
38 . F S ORDLG=+$O(^ORD(101.41,"APKG",ORPKG,ORDLG)) Q:ORDLG'>0 D
39 .. S OR0=$G(^ORD(101.41,ORDLG,0)) Q:$P(OR0,U,4)'="D" ;ck dialogs only
40 .. I ORPKG=PSJ Q:$P(OR0,U)="PSJ OR PAT OE"
41 .. I ORPKG=PSO Q:$P(OR0,U)="PSO OERR" Q:$P(OR0,U)="PSO SUPPLY"
42 .. S CNT=CNT+1,ORZ(CNT)=$J(ORDLG,7)_" "_$P(OR0,U)
43DLG1 I $O(ORZ(3)) D ;send bulletin
44 . N XMDUZ,XMY,I,XMSUB,XMTEXT,DIFROM
45 . S XMDUZ="PATCH OR*3*94 POSTINIT",XMY(.5)="" S:$G(DUZ) XMY(DUZ)=""
46 . I '$G(DUZ) S I=$G(^XTMP("OR94","DUZ")) S:I XMY(I)=""
47 . S XMSUB="PATCH OR*3*94 POSTINIT COMPLETED"
48 . S XMTEXT="ORZ(" D ^XMD
49 . D BMES^XPDUTL("The order dialogs for medications have been modified in this patch;")
50 . D MES^XPDUTL("a bulletin has been sent to the installer listing local copies that")
51 . D MES^XPDUTL("may need to be reviewed and updated.")
52 Q
53 ;
54POST ; -- postinit for MOAB
55 D IVM,QO
56 Q
57 ;
58IVM ; -- build S.IVM RX xref
59 N ORNM,ORIT
60 S ORNM="" F S ORNM=$O(^ORD(101.43,"S.UD RX",ORNM)) Q:ORNM="" D
61 . S ORIT=0 F S ORIT=+$O(^ORD(101.43,"S.UD RX",ORNM,ORIT)) Q:ORIT'>0 I '$G(^(ORIT)),$P($G(^ORD(101.43,ORIT,"PS")),U)=2 D SET^ORDD43("IVM RX",ORIT)
62 Q
63 ;
64FIRST() ; -- first install of this patch?
65 N Y S Y=$G(^XTMP("OR94","DUZ")) ;set in pre-init if first install
66 Q Y
67 ;
68QO ; -- check med QO's for inactive orderables, old OP doses
69 ;
70 Q:'$$FIRST ;conversion already run
71 ;
72 N ORODG,ORGRP,ORNOW,ORPOI,ORPDD,ORPIN,ORPFT,ORPST,ORPID,ORPAD,ORQDLG,OR0,ORDIALOG,ORIT,ORDRUG,ORPSOI,ORP,ORI,ORXX
73 S ORODG=+$O(^ORD(100.98,"B","PHARMACY",0)) D DG^ORCHANG1(ORODG,"BILD",.ORGRP)
74 S ORODG=+$O(^ORD(100.98,"B","O RX",0)),ORNOW=$$NOW^XLFDT
75 S ORPOI=+$$PTR("ORDERABLE ITEM"),ORPDD=+$$PTR("DISPENSE DRUG")
76 S ORPIN=+$$PTR("INSTRUCTIONS"),ORPFT=+$$PTR("FREE TEXT")
77 S ORPST=+$$PTR("STRENGTH"),ORPID=+$$PTR("DOSE"),ORPAD=+$$PTR("ADDITIVE")
78QO1 S ORQDLG=+$G(^XTMP("OR94","DLG")) ;find where left off, if restarted
79 F S ORQDLG=+$O(^ORD(101.41,ORQDLG)) Q:ORQDLG'>0 S OR0=$G(^(ORQDLG,0)) D
80 . Q:$P(OR0,U,4)'="Q" Q:'$D(ORGRP(+$P(OR0,U,5))) ;pharmacy qo's only
81 . K ORDIALOG,ORXX,^TMP("ORWORD",$J) D GETQDLG Q:'$D(ORDIALOG)
82 . S ORDRUG=+$G(ORDIALOG(ORPDD,1))
83 . ;
84 . ; -- Update inactive OI's, if possible
85 . F ORP=ORPOI,ORPAD S ORI=0 F S ORI=$O(ORDIALOG(ORP,ORI)) Q:ORI'>0 D
86 .. N ORITM,ORPSITM,ORNEWOI
87 .. S ORITM=+$G(ORDIALOG(ORP,ORI)) Q:ORITM'>0
88 .. Q:'$G(^ORD(101.43,ORITM,.1))!($G(^(.1))>ORNOW) ;still active
89 .. S ORPSITM=+$P($G(^ORD(101.43,ORITM,0)),U,2)
90 .. S ORNEWOI=$$EN^PSSQORD(ORPSITM,ORDRUG)
91 .. I ORNEWOI>0,$P(ORNEWOI,U,2)!($P(ORNEWOI,U,3)>ORNOW) S ORNEWOI=+$O(^ORD(101.43,"ID",+ORNEWOI_";99PSP",0)) S:ORNEWOI ORDIALOG(ORP,ORI)=ORNEWOI,ORXX=1 Q
92 .. S ^XTMP("ORIT",ORQDLG)="" ;list unconverted qo's for bulletin
93 . ;
94QO2 . ; -- Update Outpt instructions, if possible
95 . S ORIT=+$G(ORDIALOG(ORPOI,1)),ORPSOI=+$P($G(^ORD(101.43,ORIT,0)),U,2)
96 . I $P(OR0,U,5)=ORODG D
97 .. N ORDOSE,ORI,DRUG,STR D DOSE^PSSORUTL(.ORDOSE,ORPSOI,"O","")
98 .. S DRUG=$G(ORDOSE("DD",ORDRUG)),STR=$P(DRUG,U,5,6) ;"" if no ORDRUG
99 .. S ORI=0 F S ORI=$O(ORDIALOG(ORPIN,ORI)) Q:ORI'>0 D DOSE
100 .. S STR=$TR(STR,"^") I STR,$P($G(^ORD(101.43,ORIT,0)),U)'[STR S ORDIALOG(ORPST,1)=STR
101 .. ;set Drug Name if needed too?
102 . ;
103 . ; -- Save changes to quick order
104 . I $G(ORXX) D SAVE^ORCMEDT0 ;save responses if changed
105 . S ^XTMP("OR94","DLG")=ORQDLG
106 ;
107QO3 ; -- Update inactive OI's in delayed orders, if possible
108 D QO3^ORY94A
109 D BULLETIN^ORY94A
110 K ^TMP("ORWORD",$J),^TMP("ORTXT",$J),^XTMP("OR94")
111 Q
112 ;
113PTR(X) ; -- Return ptr to prompt OR GTX X
114 Q +$O(^ORD(101.41,"AB","OR GTX "_X,0))
115 ;
116GETQDLG ; -- Get quick order definition, build ORDIALOG()
117 S ORDIALOG=+$$DEFDLG^ORCD(ORQDLG) Q:'ORDIALOG
118 D GETDLG^ORCD(ORDIALOG),GETORDER^ORCD("^ORD(101.41,"_ORQDLG_",6)")
119 ; -- set additional nodes for old Noun prompt
120 N I,J,X
121 S I=0 F S I=$O(^ORD(101.41,ORQDLG,6,"D",ORPFT,I)) Q:I'>0 D
122 . S J=+$P($G(^ORD(101.41,ORQDLG,6,I,0)),U,3),X=$G(^(1))
123 . S:$D(ORDIALOG(ORPIN,J)) ORDIALOG(ORPFT,J)=X
124 Q
125 ;
126DOSE ; -- Reformat outpt dose instance ORI, if possible/necessary
127 Q:$D(ORDIALOG(ORPID,ORI)) ;already successfully converted
128 N UD,UNT,CONJ,IDX,DOSE,MATCH,X,Y
129 S UD=$G(ORDIALOG(ORPIN,ORI)),UNT=$G(ORDIALOG(ORPFT,ORI)),MATCH=0
130 S:UD="1/2" UD=.5 S:UD="1/3" UD=.33 S:UD="1/4" UD=.25 S:UD="3/4" UD=.75
131 I UNT?1.U1"(S)" S UNT=$P(UNT,"(")_$S(UD>1:"S",1:"") ;strip trailing (s)
132 S CONJ=$P($G(ORDOSE("MISC")),U,3) S:$L(CONJ) CONJ=" "_CONJ
133 S IDX="ORDOSE(0)" F S IDX=$Q(@IDX) Q:IDX'?1"ORDOSE("1.N.",".N1")" D
134 . S DOSE=@IDX,X=UD_$S('$L(UNT):"",$P(DOSE,U,3):"^"_UNT,1:" "_UNT)
135 . S X=$$UP^XLFSTR(X) I ($P(DOSE,U,3,4)=X)!($P(DOSE,U,5)=X) D
136 .. I ORDRUG,$P(DOSE,U,6)'=ORDRUG Q ;not a match
137 .. S MATCH=MATCH+1,MATCH(MATCH)=$P(DOSE,U,1,6)
138D1 K ORDIALOG(ORPFT,ORI) S ORXX=1
139 I MATCH=1 D Q ;Update responses
140 . S Y=MATCH(1),X=$P(Y,U,5)
141 . S:'Y X=X_CONJ_" "_$S($G(STR):$TR(STR,"^"),1:$P(DRUG,U))
142 . S ORDIALOG(ORPIN,ORI)=X
143 . S ORDIALOG(ORPDD,ORI)=$P(Y,U,6)
144 . S ORDIALOG(ORPID,ORI)=$TR(Y,"^","&")_"&"_$TR($G(STR),"^","&")
145 ; -- Else save free text instructions, add qo to bulletin for review
146 S ORDIALOG(ORPIN,ORI)=UD_$S($L(UNT):" "_UNT,1:"")
147 ;K ORDIALOG(ORPDD,ORI) ;clear old dispense drug?
148 S ^XTMP("ORPSO",ORQDLG)=""
149 Q
150 ;
151BULLETIN ; -- Send bulletin containing qo's we couldn't convert
152 D BULLETIN^ORY94A ;just in case
153 Q
154 ;
155DLGSEND(ANAME) ; -- Return true if the order dialog should be sent
156 I ANAME="OR GTX AND/THEN" Q 1
157 I ANAME="OR GTX DAYS SUPPLY" Q 1
158 I ANAME="OR GTX DOSE" Q 1
159 I ANAME="OR GTX DRUG NAME" Q 1
160 I ANAME="OR GTX INSTRUCTIONS" Q 1
161 I ANAME="OR GTX NOW" Q 1
162 I ANAME="OR GTX ORDERABLE ITEM" Q 1
163 I ANAME="OR GTX PATIENT INSTRUCTIONS" Q 1
164 I ANAME="OR GTX SIG" Q 1
165 I ANAME="OR GTX STRENGTH" Q 1
166 I ANAME="PS MEDS" Q 1
167 I ANAME="PSJ OR PAT OE" Q 1
168 I ANAME="PSO OERR" Q 1
169 I ANAME="PSO SUPPLY" Q 1
170 Q 0
Note: See TracBrowser for help on using the repository browser.