Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: ORB3C2

ORB3C2.m

Go to the documentation of this file.
  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 ]
  1. ;;3.0;ORDER ENTRY/RESULTS REPORTING;**9**;Dec 17, 1997
  1. Q
  1. POSTORB ;initiate post-inits for converting OE/RR 2.5 notification fields to OE/RR 3.0 notification parameters
  1. N ORBC
  1. S ORBC=$$GET^XPAR("SYS","ORBC CONVERSION",1,"Q")
  1. I +$G(ORBC)>1 D BMES^XPDUTL("Notifications already POST-converted.") Q
  1. D BMES^XPDUTL("POST-conversion of notifications...")
  1. D KILLC,PROTO,POSTRU,POSTRG,POSTPF,POSTEX
  1. D EN^XPAR("SYS","ORBC CONVERSION",1,"2",.ORBERR) ;2:post-convert done
  1. D BMES^XPDUTL("POST-conversion of notifications completed.")
  1. Q
  1. KILLC ;kill then rebuild "C" x-ref
  1. K ^ORD(100.9,"C")
  1. S DIK="^ORD(100.9,",DIK(1)=".02^C" D ENALL^DIK ;rebuild the "C" x-ref
  1. K DA,DIK
  1. Q
  1. PROTO ;update protocols
  1. N ORBP1,ORBP2,ORBPX
  1. S DIC="^ORD(101,",DIC(0)="",X="OR EVSEND DGPM" D ^DIC Q:+Y<1 S ORBP1=+Y
  1. K DIC,Y,DUOUT,DTOUT
  1. S DIC="^ORD(101,",DIC(0)="",X="DGPM PROVIDER UPDATE EVENT" D ^DIC Q:+Y<1 S ORBP2=+Y
  1. S ORBPX=0 F S ORBPX=$O(^ORD(101,ORBP1,10,ORBPX)) Q:'ORBPX Q:(+^ORD(101,ORBP1,10,ORBPX,0)=ORBP2)
  1. K DIC,Y,DUOUT,DTOUT
  1. Q:+$G(ORBPX)>0
  1. S X="Adding protocol DGPM PROVIDER UPDATE EVENT as an item on protocol OR EVSEND DGPM..."
  1. D BMES^XPDUTL(X)
  1. S:'$D(^ORD(101,ORBP1,10,0)) ^ORD(101,ORBP1,10,0)="^101.01PA^^"
  1. S (DIE,DIC)="^ORD(101,"_ORBP1_",10,"
  1. F DA=1:1 Q:'$D(^ORD(101,ORBP1,10,DA,0))
  1. S DA(1)=ORBP1,DR=".01///DGPM PROVIDER UPDATE EVENT"
  1. D ^DIE
  1. K DIC,DIE,DA,DR,X,DTOUT
  1. Q
  1. POSTRU ;post-init conversion of OE/RR 2.5 RECIPIENT USERS
  1. N ORBN,ORBU,ORBERR,X,ORBTOT,I,ORX
  1. S ORBTOT=$G(^XTMP("ORBC","USER PROCESSING FLAG",0))
  1. Q:+$G(ORBTOT)<1
  1. S XPDIDTOT=ORBTOT
  1. D UPDATE^XPDID(0)
  1. S I=0 F S I=$O(^XTMP("ORBC","USER PROCESSING FLAG",I)) Q:I="" D
  1. .D UPDATE^XPDID(I)
  1. .S ORX=^XTMP("ORBC","USER PROCESSING FLAG",I)
  1. .S ORBU=$P(ORX,U),ORBN=$P(ORX,U,2)
  1. .Q:'$L($G(^VA(200,ORBU,0)))
  1. .Q:'$L($G(^ORD(100.9,ORBN,0)))
  1. .Q:$L($$GET^XPAR("USR.`"_+ORBU,"ORB PROCESSING FLAG","`"_ORBN,"Q"))
  1. .D EN^XPAR("USR.`"_+ORBU,"ORB PROCESSING FLAG","`"_ORBN,"E",.ORBERR)
  1. .I +ORBERR>0 D
  1. ..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)_"!"
  1. ..D BMES^XPDUTL(X)
  1. K XPDIDTOT
  1. Q
  1. POSTRG ;post-init conversion of OE/RR 2.5 RECIPIENT GROUPS
  1. N ORBN,ORBT,ORBERR,X,ORBTOT,I,ORX
  1. S ORBTOT=$G(^XTMP("ORBC","DEFAULT RECIPIENTS",0))
  1. Q:+$G(ORBTOT)<1
  1. S XPDIDTOT=ORBTOT
  1. D UPDATE^XPDID(0)
  1. S I=0 F S I=$O(^XTMP("ORBC","DEFAULT RECIPIENTS",I)) Q:I="" D
  1. .D UPDATE^XPDID(I)
  1. .S ORX=^XTMP("ORBC","DEFAULT RECIPIENTS",I)
  1. .S ORBT=$P(ORX,U),ORBN=$P(ORX,U,2)
  1. .Q:'$L($G(^OR(100.21,ORBT,0)))
  1. .Q:'$L($G(^ORD(100.9,ORBN,0)))
  1. .Q:$L($$GET^XPAR("OTL.`"_+ORBT,"ORB DEFAULT RECIPIENTS","`"_ORBN,"Q"))
  1. .D EN^XPAR("OTL.`"_+ORBT,"ORB DEFAULT RECIPIENTS","`"_ORBN,"Yes",.ORBERR)
  1. .I +ORBERR>0 D
  1. ..S X="Error: "_ORBERR_" - converting RECIPIENT GROUP "_$P(^OR(100.21,ORBT,0),U)_" to ORB DEFAULT RECIPIENTS!"
  1. ..D BMES^XPDUTL(X)
  1. K XPDIDTOT
  1. Q
  1. POSTPF ;post-init conversion of OE/RR 2.5 PROCESSING FLAG
  1. N ORBN,ORBF,ORBERR,X,ORBTOT,I,ORX
  1. S ORBTOT=$G(^XTMP("ORBC","SITE PROCESSING FLAG",0))
  1. Q:+$G(ORBTOT)<1
  1. S XPDIDTOT=ORBTOT
  1. D UPDATE^XPDID(0)
  1. S I=0 F S I=$O(^XTMP("ORBC","SITE PROCESSING FLAG",I)) Q:I="" D
  1. .D UPDATE^XPDID(I)
  1. .S ORX=^XTMP("ORBC","SITE PROCESSING FLAG",I)
  1. .S ORBF=$P(ORX,U),ORBN=$P(ORX,U,2)
  1. .Q:ORBF=""
  1. .Q:'$L($G(^ORD(100.9,ORBN,0)))
  1. .Q:$L($$GET^XPAR("SYS","ORB PROCESSING FLAG","`"_ORBN,"Q"))
  1. .D EN^XPAR("SYS","ORB PROCESSING FLAG","`"_ORBN,ORBF,.ORBERR)
  1. .I +ORBERR>0 D
  1. ..S X="Error: "_ORBERR_" - converting SYSTEM to ORB PROCESSING FLAG system level for notification "_$P(^ORD(100.9,ORBN,0),U)_"!"
  1. ..D BMES^XPDUTL(X)
  1. K XPDIDTOT
  1. Q
  1. POSTEX ;post-init conversion of OE/RR 2.5 EXCLUDE ATTENDING & EXCLUDE PRIMARY
  1. N ORBN,ORBEX,ORBXA,ORBXP,ORBNTOP,ORBPKG,ORBSYS,ORBERR,X,ORBTOT,I,ORX
  1. S ORBTOT=$G(^XTMP("ORBC","PROVIDER RECIPIENTS",0))
  1. Q:+$G(ORBTOT)<1
  1. S XPDIDTOT=ORBTOT
  1. D UPDATE^XPDID(0)
  1. ;
  1. S I=0 F S I=$O(^XTMP("ORBC","PROVIDER RECIPIENTS",I)) Q:I="" D
  1. .D UPDATE^XPDID(I)
  1. .S ORX=^XTMP("ORBC","PROVIDER RECIPIENTS",I)
  1. .S ORBXA=$P(ORX,U),ORBXP=$P(ORX,U,2),ORBNTOP=$P(ORX,U,3),ORBN=$P(ORX,U,4)
  1. .I '$L(ORBNTOP),(+$G(ORBXA)<1),(+$G(ORBXP)<1) Q
  1. .I ($L(ORBNTOP))!($L(ORBXA))!($L(ORBXP)) D
  1. ..S ORBPKG=$$GET^XPAR("PKG","ORB PROVIDER RECIPIENTS","`"_ORBN,"Q")
  1. ..;
  1. ..;if Notif to Phys is "All" and Pkg value doesn't contain "P":
  1. ..I $G(ORBNTOP)=0,$F(ORBPKG,"P")=0 S ORBPKG=ORBPKG_"P"
  1. ..;
  1. ..;if Notif to Phys is Attending only and Pkg value doesn't contain "A":
  1. ..I $L(ORBNTOP)>0,$F(ORBPKG,"A")=0 S ORBPKG=ORBPKG_"A"
  1. ..;
  1. ..S ORBXA=$S($G(ORBXA)=1:"A",1:"")
  1. ..S ORBXP=$S($G(ORBXP)=1:"P",1:"")
  1. ..S ORBEX=ORBXA_ORBXP
  1. ..Q:$L($$GET^XPAR("SYS","ORB PROVIDER RECIPIENTS","`"_ORBN,"Q"))
  1. ..S ORBSYS=$TR(ORBPKG,ORBEX) ;exclude attending and/or primary
  1. ..D EN^XPAR("SYS","ORB PROVIDER RECIPIENTS","`"_ORBN,ORBSYS,.ORBERR)
  1. ..I +ORBERR>0 D
  1. ...S X="Error: "_ORBERR_" - converting EXCLUDE ATTENDING/PRIMARY "_$P(^ORD(100.9,+ORBN,0),U)_" to ORB PROVIDER RECIPIENTS system level!"
  1. ...D BMES^XPDUTL(X)
  1. K XPDIDTOT
  1. Q