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 ]
;;3.0;ORDER ENTRY/RESULTS REPORTING;**9**;Dec 17, 1997
Q
POSTORB ;initiate post-inits for converting OE/RR 2.5 notification fields to OE/RR 3.0 notification parameters
N ORBC
S ORBC=$$GET^XPAR("SYS","ORBC CONVERSION",1,"Q")
I +$G(ORBC)>1 D BMES^XPDUTL("Notifications already POST-converted.") Q
D BMES^XPDUTL("POST-conversion of notifications...")
D KILLC,PROTO,POSTRU,POSTRG,POSTPF,POSTEX
D EN^XPAR("SYS","ORBC CONVERSION",1,"2",.ORBERR) ;2:post-convert done
D BMES^XPDUTL("POST-conversion of notifications completed.")
Q
KILLC ;kill then rebuild "C" x-ref
K ^ORD(100.9,"C")
S DIK="^ORD(100.9,",DIK(1)=".02^C" D ENALL^DIK ;rebuild the "C" x-ref
K DA,DIK
Q
PROTO ;update protocols
N ORBP1,ORBP2,ORBPX
S DIC="^ORD(101,",DIC(0)="",X="OR EVSEND DGPM" D ^DIC Q:+Y<1 S ORBP1=+Y
K DIC,Y,DUOUT,DTOUT
S DIC="^ORD(101,",DIC(0)="",X="DGPM PROVIDER UPDATE EVENT" D ^DIC Q:+Y<1 S ORBP2=+Y
S ORBPX=0 F S ORBPX=$O(^ORD(101,ORBP1,10,ORBPX)) Q:'ORBPX Q:(+^ORD(101,ORBP1,10,ORBPX,0)=ORBP2)
K DIC,Y,DUOUT,DTOUT
Q:+$G(ORBPX)>0
S X="Adding protocol DGPM PROVIDER UPDATE EVENT as an item on protocol OR EVSEND DGPM..."
D BMES^XPDUTL(X)
S:'$D(^ORD(101,ORBP1,10,0)) ^ORD(101,ORBP1,10,0)="^101.01PA^^"
S (DIE,DIC)="^ORD(101,"_ORBP1_",10,"
F DA=1:1 Q:'$D(^ORD(101,ORBP1,10,DA,0))
S DA(1)=ORBP1,DR=".01///DGPM PROVIDER UPDATE EVENT"
D ^DIE
K DIC,DIE,DA,DR,X,DTOUT
Q
POSTRU ;post-init conversion of OE/RR 2.5 RECIPIENT USERS
N ORBN,ORBU,ORBERR,X,ORBTOT,I,ORX
S ORBTOT=$G(^XTMP("ORBC","USER PROCESSING FLAG",0))
Q:+$G(ORBTOT)<1
S XPDIDTOT=ORBTOT
D UPDATE^XPDID(0)
S I=0 F S I=$O(^XTMP("ORBC","USER PROCESSING FLAG",I)) Q:I="" D
.D UPDATE^XPDID(I)
.S ORX=^XTMP("ORBC","USER PROCESSING FLAG",I)
.S ORBU=$P(ORX,U),ORBN=$P(ORX,U,2)
.Q:'$L($G(^VA(200,ORBU,0)))
.Q:'$L($G(^ORD(100.9,ORBN,0)))
.Q:$L($$GET^XPAR("USR.`"_+ORBU,"ORB PROCESSING FLAG","`"_ORBN,"Q"))
.D EN^XPAR("USR.`"_+ORBU,"ORB PROCESSING FLAG","`"_ORBN,"E",.ORBERR)
.I +ORBERR>0 D
..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)_"!"
..D BMES^XPDUTL(X)
K XPDIDTOT
Q
POSTRG ;post-init conversion of OE/RR 2.5 RECIPIENT GROUPS
N ORBN,ORBT,ORBERR,X,ORBTOT,I,ORX
S ORBTOT=$G(^XTMP("ORBC","DEFAULT RECIPIENTS",0))
Q:+$G(ORBTOT)<1
S XPDIDTOT=ORBTOT
D UPDATE^XPDID(0)
S I=0 F S I=$O(^XTMP("ORBC","DEFAULT RECIPIENTS",I)) Q:I="" D
.D UPDATE^XPDID(I)
.S ORX=^XTMP("ORBC","DEFAULT RECIPIENTS",I)
.S ORBT=$P(ORX,U),ORBN=$P(ORX,U,2)
.Q:'$L($G(^OR(100.21,ORBT,0)))
.Q:'$L($G(^ORD(100.9,ORBN,0)))
.Q:$L($$GET^XPAR("OTL.`"_+ORBT,"ORB DEFAULT RECIPIENTS","`"_ORBN,"Q"))
.D EN^XPAR("OTL.`"_+ORBT,"ORB DEFAULT RECIPIENTS","`"_ORBN,"Yes",.ORBERR)
.I +ORBERR>0 D
..S X="Error: "_ORBERR_" - converting RECIPIENT GROUP "_$P(^OR(100.21,ORBT,0),U)_" to ORB DEFAULT RECIPIENTS!"
..D BMES^XPDUTL(X)
K XPDIDTOT
Q
POSTPF ;post-init conversion of OE/RR 2.5 PROCESSING FLAG
N ORBN,ORBF,ORBERR,X,ORBTOT,I,ORX
S ORBTOT=$G(^XTMP("ORBC","SITE PROCESSING FLAG",0))
Q:+$G(ORBTOT)<1
S XPDIDTOT=ORBTOT
D UPDATE^XPDID(0)
S I=0 F S I=$O(^XTMP("ORBC","SITE PROCESSING FLAG",I)) Q:I="" D
.D UPDATE^XPDID(I)
.S ORX=^XTMP("ORBC","SITE PROCESSING FLAG",I)
.S ORBF=$P(ORX,U),ORBN=$P(ORX,U,2)
.Q:ORBF=""
.Q:'$L($G(^ORD(100.9,ORBN,0)))
.Q:$L($$GET^XPAR("SYS","ORB PROCESSING FLAG","`"_ORBN,"Q"))
.D EN^XPAR("SYS","ORB PROCESSING FLAG","`"_ORBN,ORBF,.ORBERR)
.I +ORBERR>0 D
..S X="Error: "_ORBERR_" - converting SYSTEM to ORB PROCESSING FLAG system level for notification "_$P(^ORD(100.9,ORBN,0),U)_"!"
..D BMES^XPDUTL(X)
K XPDIDTOT
Q
POSTEX ;post-init conversion of OE/RR 2.5 EXCLUDE ATTENDING & EXCLUDE PRIMARY
N ORBN,ORBEX,ORBXA,ORBXP,ORBNTOP,ORBPKG,ORBSYS,ORBERR,X,ORBTOT,I,ORX
S ORBTOT=$G(^XTMP("ORBC","PROVIDER RECIPIENTS",0))
Q:+$G(ORBTOT)<1
S XPDIDTOT=ORBTOT
D UPDATE^XPDID(0)
;
S I=0 F S I=$O(^XTMP("ORBC","PROVIDER RECIPIENTS",I)) Q:I="" D
.D UPDATE^XPDID(I)
.S ORX=^XTMP("ORBC","PROVIDER RECIPIENTS",I)
.S ORBXA=$P(ORX,U),ORBXP=$P(ORX,U,2),ORBNTOP=$P(ORX,U,3),ORBN=$P(ORX,U,4)
.I '$L(ORBNTOP),(+$G(ORBXA)<1),(+$G(ORBXP)<1) Q
.I ($L(ORBNTOP))!($L(ORBXA))!($L(ORBXP)) D
..S ORBPKG=$$GET^XPAR("PKG","ORB PROVIDER RECIPIENTS","`"_ORBN,"Q")
..;
..;if Notif to Phys is "All" and Pkg value doesn't contain "P":
..I $G(ORBNTOP)=0,$F(ORBPKG,"P")=0 S ORBPKG=ORBPKG_"P"
..;
..;if Notif to Phys is Attending only and Pkg value doesn't contain "A":
..I $L(ORBNTOP)>0,$F(ORBPKG,"A")=0 S ORBPKG=ORBPKG_"A"
..;
..S ORBXA=$S($G(ORBXA)=1:"A",1:"")
..S ORBXP=$S($G(ORBXP)=1:"P",1:"")
..S ORBEX=ORBXA_ORBXP
..Q:$L($$GET^XPAR("SYS","ORB PROVIDER RECIPIENTS","`"_ORBN,"Q"))
..S ORBSYS=$TR(ORBPKG,ORBEX) ;exclude attending and/or primary
..D EN^XPAR("SYS","ORB PROVIDER RECIPIENTS","`"_ORBN,ORBSYS,.ORBERR)
..I +ORBERR>0 D
...S X="Error: "_ORBERR_" - converting EXCLUDE ATTENDING/PRIMARY "_$P(^ORD(100.9,+ORBN,0),U)_" to ORB PROVIDER RECIPIENTS system level!"
...D BMES^XPDUTL(X)
K XPDIDTOT
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HORB3C2 5228 printed Apr 09, 2024@21:36:29 Page 2
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
+2 QUIT
POSTORB ;initiate post-inits for converting OE/RR 2.5 notification fields to OE/RR 3.0 notification parameters
+1 NEW ORBC
+2 SET ORBC=$$GET^XPAR("SYS","ORBC CONVERSION",1,"Q")
+3 IF +$GET(ORBC)>1
DO BMES^XPDUTL("Notifications already POST-converted.")
QUIT
+4 DO BMES^XPDUTL("POST-conversion of notifications...")
+5 DO KILLC
DO PROTO
DO POSTRU
DO POSTRG
DO POSTPF
DO POSTEX
+6 ;2:post-convert done
DO EN^XPAR("SYS","ORBC CONVERSION",1,"2",.ORBERR)
+7 DO BMES^XPDUTL("POST-conversion of notifications completed.")
+8 QUIT
KILLC ;kill then rebuild "C" x-ref
+1 KILL ^ORD(100.9,"C")
+2 ;rebuild the "C" x-ref
SET DIK="^ORD(100.9,"
SET DIK(1)=".02^C"
DO ENALL^DIK
+3 KILL DA,DIK
+4 QUIT
PROTO ;update protocols
+1 NEW ORBP1,ORBP2,ORBPX
+2 SET DIC="^ORD(101,"
SET DIC(0)=""
SET X="OR EVSEND DGPM"
DO ^DIC
if +Y<1
QUIT
SET ORBP1=+Y
+3 KILL DIC,Y,DUOUT,DTOUT
+4 SET DIC="^ORD(101,"
SET DIC(0)=""
SET X="DGPM PROVIDER UPDATE EVENT"
DO ^DIC
if +Y<1
QUIT
SET ORBP2=+Y
+5 SET ORBPX=0
FOR
SET ORBPX=$ORDER(^ORD(101,ORBP1,10,ORBPX))
if 'ORBPX
QUIT
if (+^ORD(101,ORBP1,10,ORBPX,0)=ORBP2)
QUIT
+6 KILL DIC,Y,DUOUT,DTOUT
+7 if +$GET(ORBPX)>0
QUIT
+8 SET X="Adding protocol DGPM PROVIDER UPDATE EVENT as an item on protocol OR EVSEND DGPM..."
+9 DO BMES^XPDUTL(X)
+10 if '$DATA(^ORD(101,ORBP1,10,0))
SET ^ORD(101,ORBP1,10,0)="^101.01PA^^"
+11 SET (DIE,DIC)="^ORD(101,"_ORBP1_",10,"
+12 FOR DA=1:1
if '$DATA(^ORD(101,ORBP1,10,DA,0))
QUIT
+13 SET DA(1)=ORBP1
SET DR=".01///DGPM PROVIDER UPDATE EVENT"
+14 DO ^DIE
+15 KILL DIC,DIE,DA,DR,X,DTOUT
+16 QUIT
POSTRU ;post-init conversion of OE/RR 2.5 RECIPIENT USERS
+1 NEW ORBN,ORBU,ORBERR,X,ORBTOT,I,ORX
+2 SET ORBTOT=$GET(^XTMP("ORBC","USER PROCESSING FLAG",0))
+3 if +$GET(ORBTOT)<1
QUIT
+4 SET XPDIDTOT=ORBTOT
+5 DO UPDATE^XPDID(0)
+6 SET I=0
FOR
SET I=$ORDER(^XTMP("ORBC","USER PROCESSING FLAG",I))
if I=""
QUIT
Begin DoDot:1
+7 DO UPDATE^XPDID(I)
+8 SET ORX=^XTMP("ORBC","USER PROCESSING FLAG",I)
+9 SET ORBU=$PIECE(ORX,U)
SET ORBN=$PIECE(ORX,U,2)
+10 if '$LENGTH($GET(^VA(200,ORBU,0)))
QUIT
+11 if '$LENGTH($GET(^ORD(100.9,ORBN,0)))
QUIT
+12 if $LENGTH($$GET^XPAR("USR.`"_+ORBU,"ORB PROCESSING FLAG","`"_ORBN,"Q"))
QUIT
+13 DO EN^XPAR("USR.`"_+ORBU,"ORB PROCESSING FLAG","`"_ORBN,"E",.ORBERR)
+14 IF +ORBERR>0
Begin DoDot:2
+15 SET X="Error: "_ORBERR_" - converting USER "_$PIECE(^VA(200,ORBU,0),U)_" to ORB PROCESSING FLAG user level for notification "_$PIECE(^ORD(100.9,ORBN,0),U)_"!"
+16 DO BMES^XPDUTL(X)
End DoDot:2
End DoDot:1
+17 KILL XPDIDTOT
+18 QUIT
POSTRG ;post-init conversion of OE/RR 2.5 RECIPIENT GROUPS
+1 NEW ORBN,ORBT,ORBERR,X,ORBTOT,I,ORX
+2 SET ORBTOT=$GET(^XTMP("ORBC","DEFAULT RECIPIENTS",0))
+3 if +$GET(ORBTOT)<1
QUIT
+4 SET XPDIDTOT=ORBTOT
+5 DO UPDATE^XPDID(0)
+6 SET I=0
FOR
SET I=$ORDER(^XTMP("ORBC","DEFAULT RECIPIENTS",I))
if I=""
QUIT
Begin DoDot:1
+7 DO UPDATE^XPDID(I)
+8 SET ORX=^XTMP("ORBC","DEFAULT RECIPIENTS",I)
+9 SET ORBT=$PIECE(ORX,U)
SET ORBN=$PIECE(ORX,U,2)
+10 if '$LENGTH($GET(^OR(100.21,ORBT,0)))
QUIT
+11 if '$LENGTH($GET(^ORD(100.9,ORBN,0)))
QUIT
+12 if $LENGTH($$GET^XPAR("OTL.`"_+ORBT,"ORB DEFAULT RECIPIENTS","`"_ORBN,"Q"))
QUIT
+13 DO EN^XPAR("OTL.`"_+ORBT,"ORB DEFAULT RECIPIENTS","`"_ORBN,"Yes",.ORBERR)
+14 IF +ORBERR>0
Begin DoDot:2
+15 SET X="Error: "_ORBERR_" - converting RECIPIENT GROUP "_$PIECE(^OR(100.21,ORBT,0),U)_" to ORB DEFAULT RECIPIENTS!"
+16 DO BMES^XPDUTL(X)
End DoDot:2
End DoDot:1
+17 KILL XPDIDTOT
+18 QUIT
POSTPF ;post-init conversion of OE/RR 2.5 PROCESSING FLAG
+1 NEW ORBN,ORBF,ORBERR,X,ORBTOT,I,ORX
+2 SET ORBTOT=$GET(^XTMP("ORBC","SITE PROCESSING FLAG",0))
+3 if +$GET(ORBTOT)<1
QUIT
+4 SET XPDIDTOT=ORBTOT
+5 DO UPDATE^XPDID(0)
+6 SET I=0
FOR
SET I=$ORDER(^XTMP("ORBC","SITE PROCESSING FLAG",I))
if I=""
QUIT
Begin DoDot:1
+7 DO UPDATE^XPDID(I)
+8 SET ORX=^XTMP("ORBC","SITE PROCESSING FLAG",I)
+9 SET ORBF=$PIECE(ORX,U)
SET ORBN=$PIECE(ORX,U,2)
+10 if ORBF=""
QUIT
+11 if '$LENGTH($GET(^ORD(100.9,ORBN,0)))
QUIT
+12 if $LENGTH($$GET^XPAR("SYS","ORB PROCESSING FLAG","`"_ORBN,"Q"))
QUIT
+13 DO EN^XPAR("SYS","ORB PROCESSING FLAG","`"_ORBN,ORBF,.ORBERR)
+14 IF +ORBERR>0
Begin DoDot:2
+15 SET X="Error: "_ORBERR_" - converting SYSTEM to ORB PROCESSING FLAG system level for notification "_$PIECE(^ORD(100.9,ORBN,0),U)_"!"
+16 DO BMES^XPDUTL(X)
End DoDot:2
End DoDot:1
+17 KILL XPDIDTOT
+18 QUIT
POSTEX ;post-init conversion of OE/RR 2.5 EXCLUDE ATTENDING & EXCLUDE PRIMARY
+1 NEW ORBN,ORBEX,ORBXA,ORBXP,ORBNTOP,ORBPKG,ORBSYS,ORBERR,X,ORBTOT,I,ORX
+2 SET ORBTOT=$GET(^XTMP("ORBC","PROVIDER RECIPIENTS",0))
+3 if +$GET(ORBTOT)<1
QUIT
+4 SET XPDIDTOT=ORBTOT
+5 DO UPDATE^XPDID(0)
+6 ;
+7 SET I=0
FOR
SET I=$ORDER(^XTMP("ORBC","PROVIDER RECIPIENTS",I))
if I=""
QUIT
Begin DoDot:1
+8 DO UPDATE^XPDID(I)
+9 SET ORX=^XTMP("ORBC","PROVIDER RECIPIENTS",I)
+10 SET ORBXA=$PIECE(ORX,U)
SET ORBXP=$PIECE(ORX,U,2)
SET ORBNTOP=$PIECE(ORX,U,3)
SET ORBN=$PIECE(ORX,U,4)
+11 IF '$LENGTH(ORBNTOP)
IF (+$GET(ORBXA)<1)
IF (+$GET(ORBXP)<1)
QUIT
+12 IF ($LENGTH(ORBNTOP))!($LENGTH(ORBXA))!($LENGTH(ORBXP))
Begin DoDot:2
+13 SET ORBPKG=$$GET^XPAR("PKG","ORB PROVIDER RECIPIENTS","`"_ORBN,"Q")
+14 ;
+15 ;if Notif to Phys is "All" and Pkg value doesn't contain "P":
+16 IF $GET(ORBNTOP)=0
IF $FIND(ORBPKG,"P")=0
SET ORBPKG=ORBPKG_"P"
+17 ;
+18 ;if Notif to Phys is Attending only and Pkg value doesn't contain "A":
+19 IF $LENGTH(ORBNTOP)>0
IF $FIND(ORBPKG,"A")=0
SET ORBPKG=ORBPKG_"A"
+20 ;
+21 SET ORBXA=$SELECT($GET(ORBXA)=1:"A",1:"")
+22 SET ORBXP=$SELECT($GET(ORBXP)=1:"P",1:"")
+23 SET ORBEX=ORBXA_ORBXP
+24 if $LENGTH($$GET^XPAR("SYS","ORB PROVIDER RECIPIENTS","`"_ORBN,"Q"))
QUIT
+25 ;exclude attending and/or primary
SET ORBSYS=$TRANSLATE(ORBPKG,ORBEX)
+26 DO EN^XPAR("SYS","ORB PROVIDER RECIPIENTS","`"_ORBN,ORBSYS,.ORBERR)
+27 IF +ORBERR>0
Begin DoDot:3
+28 SET X="Error: "_ORBERR_" - converting EXCLUDE ATTENDING/PRIMARY "_$PIECE(^ORD(100.9,+ORBN,0),U)_" to ORB PROVIDER RECIPIENTS system level!"
+29 DO BMES^XPDUTL(X)
End DoDot:3
End DoDot:2
End DoDot:1
+30 KILL XPDIDTOT
+31 QUIT
