- 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
- 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