source: FOIAVistA/trunk/r/ORDER_ENTRY_RESULTS_REPORTING-OR-OCX--ORRC--ORRJ/ORB3C2.m@ 738

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

initial load of FOIAVistA 6/30/08 version
File size: 5.0 KB
Line 
1ORB3C2 ; slc/CLA - Routine to post-convert OE/RR 2.5 to OE/RR 3 notifications ;12/2/97 9:52 [ 04/03/97 1:41 PM ]
2 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**9**;Dec 17, 1997
3 Q
4POSTORB ;initiate post-inits for converting OE/RR 2.5 notification fields to OE/RR 3.0 notification parameters
5 N ORBC
6 S ORBC=$$GET^XPAR("SYS","ORBC CONVERSION",1,"Q")
7 I +$G(ORBC)>1 D BMES^XPDUTL("Notifications already POST-converted.") Q
8 D BMES^XPDUTL("POST-conversion of notifications...")
9 D KILLC,PROTO,POSTRU,POSTRG,POSTPF,POSTEX
10 D EN^XPAR("SYS","ORBC CONVERSION",1,"2",.ORBERR) ;2:post-convert done
11 D BMES^XPDUTL("POST-conversion of notifications completed.")
12 Q
13KILLC ;kill then rebuild "C" x-ref
14 K ^ORD(100.9,"C")
15 S DIK="^ORD(100.9,",DIK(1)=".02^C" D ENALL^DIK ;rebuild the "C" x-ref
16 K DA,DIK
17 Q
18PROTO ;update protocols
19 N ORBP1,ORBP2,ORBPX
20 S DIC="^ORD(101,",DIC(0)="",X="OR EVSEND DGPM" D ^DIC Q:+Y<1 S ORBP1=+Y
21 K DIC,Y,DUOUT,DTOUT
22 S DIC="^ORD(101,",DIC(0)="",X="DGPM PROVIDER UPDATE EVENT" D ^DIC Q:+Y<1 S ORBP2=+Y
23 S ORBPX=0 F S ORBPX=$O(^ORD(101,ORBP1,10,ORBPX)) Q:'ORBPX Q:(+^ORD(101,ORBP1,10,ORBPX,0)=ORBP2)
24 K DIC,Y,DUOUT,DTOUT
25 Q:+$G(ORBPX)>0
26 S X="Adding protocol DGPM PROVIDER UPDATE EVENT as an item on protocol OR EVSEND DGPM..."
27 D BMES^XPDUTL(X)
28 S:'$D(^ORD(101,ORBP1,10,0)) ^ORD(101,ORBP1,10,0)="^101.01PA^^"
29 S (DIE,DIC)="^ORD(101,"_ORBP1_",10,"
30 F DA=1:1 Q:'$D(^ORD(101,ORBP1,10,DA,0))
31 S DA(1)=ORBP1,DR=".01///DGPM PROVIDER UPDATE EVENT"
32 D ^DIE
33 K DIC,DIE,DA,DR,X,DTOUT
34 Q
35POSTRU ;post-init conversion of OE/RR 2.5 RECIPIENT USERS
36 N ORBN,ORBU,ORBERR,X,ORBTOT,I,ORX
37 S ORBTOT=$G(^XTMP("ORBC","USER PROCESSING FLAG",0))
38 Q:+$G(ORBTOT)<1
39 S XPDIDTOT=ORBTOT
40 D UPDATE^XPDID(0)
41 S I=0 F S I=$O(^XTMP("ORBC","USER PROCESSING FLAG",I)) Q:I="" D
42 .D UPDATE^XPDID(I)
43 .S ORX=^XTMP("ORBC","USER PROCESSING FLAG",I)
44 .S ORBU=$P(ORX,U),ORBN=$P(ORX,U,2)
45 .Q:'$L($G(^VA(200,ORBU,0)))
46 .Q:'$L($G(^ORD(100.9,ORBN,0)))
47 .Q:$L($$GET^XPAR("USR.`"_+ORBU,"ORB PROCESSING FLAG","`"_ORBN,"Q"))
48 .D EN^XPAR("USR.`"_+ORBU,"ORB PROCESSING FLAG","`"_ORBN,"E",.ORBERR)
49 .I +ORBERR>0 D
50 ..S X="Error: "_ORBERR_" - converting USER "_$P(^VA(200,ORBU,0),U)_" to ORB PROCESSING FLAG user level for notification "_$P(^ORD(100.9,ORBN,0),U)_"!"
51 ..D BMES^XPDUTL(X)
52 K XPDIDTOT
53 Q
54POSTRG ;post-init conversion of OE/RR 2.5 RECIPIENT GROUPS
55 N ORBN,ORBT,ORBERR,X,ORBTOT,I,ORX
56 S ORBTOT=$G(^XTMP("ORBC","DEFAULT RECIPIENTS",0))
57 Q:+$G(ORBTOT)<1
58 S XPDIDTOT=ORBTOT
59 D UPDATE^XPDID(0)
60 S I=0 F S I=$O(^XTMP("ORBC","DEFAULT RECIPIENTS",I)) Q:I="" D
61 .D UPDATE^XPDID(I)
62 .S ORX=^XTMP("ORBC","DEFAULT RECIPIENTS",I)
63 .S ORBT=$P(ORX,U),ORBN=$P(ORX,U,2)
64 .Q:'$L($G(^OR(100.21,ORBT,0)))
65 .Q:'$L($G(^ORD(100.9,ORBN,0)))
66 .Q:$L($$GET^XPAR("OTL.`"_+ORBT,"ORB DEFAULT RECIPIENTS","`"_ORBN,"Q"))
67 .D EN^XPAR("OTL.`"_+ORBT,"ORB DEFAULT RECIPIENTS","`"_ORBN,"Yes",.ORBERR)
68 .I +ORBERR>0 D
69 ..S X="Error: "_ORBERR_" - converting RECIPIENT GROUP "_$P(^OR(100.21,ORBT,0),U)_" to ORB DEFAULT RECIPIENTS!"
70 ..D BMES^XPDUTL(X)
71 K XPDIDTOT
72 Q
73POSTPF ;post-init conversion of OE/RR 2.5 PROCESSING FLAG
74 N ORBN,ORBF,ORBERR,X,ORBTOT,I,ORX
75 S ORBTOT=$G(^XTMP("ORBC","SITE PROCESSING FLAG",0))
76 Q:+$G(ORBTOT)<1
77 S XPDIDTOT=ORBTOT
78 D UPDATE^XPDID(0)
79 S I=0 F S I=$O(^XTMP("ORBC","SITE PROCESSING FLAG",I)) Q:I="" D
80 .D UPDATE^XPDID(I)
81 .S ORX=^XTMP("ORBC","SITE PROCESSING FLAG",I)
82 .S ORBF=$P(ORX,U),ORBN=$P(ORX,U,2)
83 .Q:ORBF=""
84 .Q:'$L($G(^ORD(100.9,ORBN,0)))
85 .Q:$L($$GET^XPAR("SYS","ORB PROCESSING FLAG","`"_ORBN,"Q"))
86 .D EN^XPAR("SYS","ORB PROCESSING FLAG","`"_ORBN,ORBF,.ORBERR)
87 .I +ORBERR>0 D
88 ..S X="Error: "_ORBERR_" - converting SYSTEM to ORB PROCESSING FLAG system level for notification "_$P(^ORD(100.9,ORBN,0),U)_"!"
89 ..D BMES^XPDUTL(X)
90 K XPDIDTOT
91 Q
92POSTEX ;post-init conversion of OE/RR 2.5 EXCLUDE ATTENDING & EXCLUDE PRIMARY
93 N ORBN,ORBEX,ORBXA,ORBXP,ORBNTOP,ORBPKG,ORBSYS,ORBERR,X,ORBTOT,I,ORX
94 S ORBTOT=$G(^XTMP("ORBC","PROVIDER RECIPIENTS",0))
95 Q:+$G(ORBTOT)<1
96 S XPDIDTOT=ORBTOT
97 D UPDATE^XPDID(0)
98 ;
99 S I=0 F S I=$O(^XTMP("ORBC","PROVIDER RECIPIENTS",I)) Q:I="" D
100 .D UPDATE^XPDID(I)
101 .S ORX=^XTMP("ORBC","PROVIDER RECIPIENTS",I)
102 .S ORBXA=$P(ORX,U),ORBXP=$P(ORX,U,2),ORBNTOP=$P(ORX,U,3),ORBN=$P(ORX,U,4)
103 .I '$L(ORBNTOP),(+$G(ORBXA)<1),(+$G(ORBXP)<1) Q
104 .I ($L(ORBNTOP))!($L(ORBXA))!($L(ORBXP)) D
105 ..S ORBPKG=$$GET^XPAR("PKG","ORB PROVIDER RECIPIENTS","`"_ORBN,"Q")
106 ..;
107 ..;if Notif to Phys is "All" and Pkg value doesn't contain "P":
108 ..I $G(ORBNTOP)=0,$F(ORBPKG,"P")=0 S ORBPKG=ORBPKG_"P"
109 ..;
110 ..;if Notif to Phys is Attending only and Pkg value doesn't contain "A":
111 ..I $L(ORBNTOP)>0,$F(ORBPKG,"A")=0 S ORBPKG=ORBPKG_"A"
112 ..;
113 ..S ORBXA=$S($G(ORBXA)=1:"A",1:"")
114 ..S ORBXP=$S($G(ORBXP)=1:"P",1:"")
115 ..S ORBEX=ORBXA_ORBXP
116 ..Q:$L($$GET^XPAR("SYS","ORB PROVIDER RECIPIENTS","`"_ORBN,"Q"))
117 ..S ORBSYS=$TR(ORBPKG,ORBEX) ;exclude attending and/or primary
118 ..D EN^XPAR("SYS","ORB PROVIDER RECIPIENTS","`"_ORBN,ORBSYS,.ORBERR)
119 ..I +ORBERR>0 D
120 ...S X="Error: "_ORBERR_" - converting EXCLUDE ATTENDING/PRIMARY "_$P(^ORD(100.9,+ORBN,0),U)_" to ORB PROVIDER RECIPIENTS system level!"
121 ...D BMES^XPDUTL(X)
122 K XPDIDTOT
123 Q
Note: See TracBrowser for help on using the repository browser.