| 1 | ORB3C2 ; 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
|
---|
| 4 | POSTORB ;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
|
---|
| 13 | KILLC ;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
|
---|
| 18 | PROTO ;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
|
---|
| 35 | POSTRU ;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
|
---|
| 54 | POSTRG ;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
|
---|
| 73 | POSTPF ;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
|
---|
| 92 | POSTEX ;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
|
---|