IBY320PR ;ALB/ESG - Pre-Install for IB patch 320 ;05-JAN-2006
;;2.0;INTEGRATED BILLING;**320**;21-MAR-94
;
D DELLOC ; delete local output formatter overrides
D DELOF ; delete output formatter entries
D DELLIST ; delete modified list templates
D DELXREFS ; Delete XREFS added in ealier version of this patch
D EMAIL ; generate message with existing provider ID types
;
Q
;
DELOF ; Delete included output formatter entries
NEW FILE,DIK,LN,TAG,DATA,PCE,DA,Y
F FILE=5,6,7 S DIK="^IBA(364."_FILE_"," F LN=2:1 S TAG="ENT"_FILE_"+"_LN,DATA=$P($T(@TAG),";;",2) Q:DATA="" D
. F PCE=2:1 S DA=$P(DATA,U,PCE) Q:'DA I $D(^IBA("364."_FILE,DA,0)) D ^DIK
. Q
;
; Also delete output formatter entries which are not going to be
; re-added later. These are erroneous entries in file 364.6.
S DIK="^IBA(364.6,",TAG="DEL6+2",DATA=$P($T(@TAG),";;",2)
I DATA'="" D
. F PCE=2:1 S DA=$P(DATA,U,PCE) Q:'DA I $D(^IBA(364.6,DA,0)) D ^DIK
. Q
;
; Also delete output formatter entries which are not going to be
; re-added later. These are erroneous entries in file 364.7.
S DIK="^IBA(364.7,",TAG="DEL7+2",DATA=$P($T(@TAG),";;",2)
I DATA'="" D
. F PCE=2:1 S DA=$P(DATA,U,PCE) Q:'DA I $D(^IBA(364.7,DA,0)) D ^DIK
. Q
DELOFX ;
Q
;
INCLUDE(FILE,Y) ; function to determine if output formatter entry should be
; included in the build
; FILE=5,6,7 indicating file 364.x
; Y=ien to file
;
NEW OK,LN,TAG,DATA
S OK=0
F LN=2:1 S TAG="ENT"_FILE_"+"_LN,DATA=$P($T(@TAG),";;",2) Q:DATA="" I $F(DATA,U_Y_U) S OK=1 Q
INCLUDEX ;
Q OK
;
ENT5 ; output formatter entries in file 364.5 to be included
;
;;^111^112^113^
;;
;
ENT6 ; output formatter entries in file 364.6 to be included
;
;;^169^226^227^968^971^1015^1051^1065^1094^1095^1096^1097^
;;^1098^1099^1100^1101^1102^1103^1104^1190^1191^1192^1289^1316^1317^
;;
;
ENT7 ; output formatter entries in file 364.7 to be included
;
;;^12^156^157^159^160^188^196^203^204^208^209^211^225^226^227^256^
;;^375^376^377^378^379^380^381^382^383^384^
;;^385^387^388^389^390^392^393^395^396^397^398^399^400^401^402^
;;^403^405^406^407^408^409^410^411^412^413^552^553^554^555^556^557^558^
;;^559^576^577^578^579^580^581^582^583^584^585^586^587^588^589^590^591^
;;^646^900^947^948^954^1009^1015^1020^1022^1023^1031^1032^1033^
;;
;
DEL6 ; remove output formatter entries in file 364.6 (not re-added)
;
;;^1066^1067^1068^1069^1071^1013^1302^
;;
;
DEL7 ; remove output formatter entries in file 364.7 (not re-added)
;
;;^187^214^249^302^316^324^325^353^468^568^570^571^572^573^574^575^899^1014^1017^
;;
;
Q
;
DELLOC ; This procedure removes certain local output formatter overrides
;
NEW FORM,IBX2,NI6,NI7,LI6,LI7,DIK,DA,DIE,DR,IBY,XMDUZ,XMSUBJ,XMBODY,XMTO
;
S DIE=353,DA=8,DR="2.08///@;2.05///@" D ^DIE ; to make sure EDI uses #8
;
S IBY="P320-LOFO" ; patch 320 local output formatter override
KILL ^TMP($J,IBY)
S ^TMP($J,IBY)=0
;
S FORM=8 ; start here to skip over the normal national form types
F S FORM=$O(^IBE(353,FORM)) Q:'FORM D
. S IBX2=$G(^IBE(353,FORM,2))
. I $P(IBX2,U,2)'="T" Q ; only deal with transmitted forms
. I $P(IBX2,U,4) Q ; don't mess with national form types
. I '$P(IBX2,U,5) D DELFRM(FORM) Q ; no parent form type
. ;
. ; Check local overrides one by one
. S NI6=0 F S NI6=$O(^IBA(364.6,"APAR",FORM,NI6)) Q:'NI6 D
.. S NI7=$O(^IBA(364.7,"B",NI6,0)) Q:'NI7
.. I '$$INCLUDE(6,NI6),'$$INCLUDE(7,NI7) Q ; not included with patch
.. S LI6=0 F S LI6=$O(^IBA(364.6,"APAR",FORM,NI6,LI6)) Q:'LI6 D
... S LI7=0 F S LI7=$O(^IBA(364.7,"B",LI6,LI7)) Q:'LI7 D
.... D DISP(LI6,LI7) ; display data before deletion
.... S DIK="^IBA(364.7,",DA=LI7 D ^DIK
.... Q
... S DIK="^IBA(364.6,",DA=LI6 D ^DIK
... Q
.. Q
. ;
. ; delete the local form if there are no more overrides
. I '$D(^IBA(364.6,"APAR",FORM)) S DIK="^IBE(353,",DA=FORM D ^DIK
. Q
;
I '$G(^TMP($J,IBY)) G DELLOCX ; no message data to send
;
; send message
S XMDUZ=DUZ
S XMSUBJ="Removal of local output formatter overrides (IB*2*320)"
S XMBODY="^TMP($J,"""_IBY_""")"
S XMTO(DUZ)=""
S XMTO("G.IB EDI SUPERVISOR")=""
D SENDMSG^XMXAPI(XMDUZ,XMSUBJ,XMBODY,.XMTO)
KILL ^TMP($J,IBY)
DELLOCX ;
Q
;
DISP(LI6,LI7) ; Display output formatter data on screen and in install file
; LI6 - local ien to file 364.6
; LI7 - local ien to file 364.7
NEW LD6,NI6,ND6,LD70,LD71,INS,LDC,MSG,Q,ZLN,FIEN,FL,GG
S LD6=$G(^IBA(364.6,LI6,0)),NI6=+$P(LD6,U,3),ND6=$G(^IBA(364.6,NI6,0))
S LD70=$G(^IBA(364.7,LI7,0)),LD71=$G(^IBA(364.7,LI7,1))
S INS=$$INSCO^IBCNSC02(+$P(LD70,U,5)),FIEN=+$P(LD6,U,1)
M LDC=^IBA(364.7,LI7,3)
S MSG(1)="Removing local output formatter field: Sequence# "
S MSG(1)=MSG(1)_$P(ND6,U,4)_", Piece# "_$P(ND6,U,8)
S MSG(2)=$$FO^IBCNEUT1(" Local 364.6 ien="_LI6,25)
S MSG(2)=MSG(2)_"- "_$P(LD6,U,10)
S MSG(3)=$$FO^IBCNEUT1(" Nat'l 364.6 ien="_NI6,25)
S MSG(3)=MSG(3)_"- "_$P(ND6,U,10)
S MSG(4)=" Local 364.7 ien="_LI7
S MSG(5)=" Form: "_$$EXTERNAL^DILFD(364.6,.01,,$P(LD6,U,1))_" ("_$P(LD6,U,1)_")"
S MSG(6)=" Data Element: "_$$EXTERNAL^DILFD(364.7,.03,,$P(LD70,U,3))
S MSG(7)=" Ins. Company: "_$E(INS,1,53)
S MSG(8)=$J("",44)_$E(INS,54,99)
S MSG(9)=" Bill Type: "_$$EXTERNAL^DILFD(364.7,.06,,$P(LD70,U,6))
S MSG(10)=" Format Code: "_LD71
S MSG(11)=" Description: "_$G(LDC(1,0))
S Q=1,ZLN=11 F S Q=$O(LDC(Q)) Q:'Q S ZLN=ZLN+1,MSG(ZLN)=" "_$G(LDC(Q,0))
S ZLN=ZLN+1,MSG(ZLN)="--------------------------------------------------------------------------"
S ZLN=ZLN+1,MSG(ZLN)=""
;
; update mailman message array
S GG=+$G(^TMP($J,IBY))
F FL=1:1:ZLN S GG=GG+1,^TMP($J,IBY,GG)=$G(MSG(FL)),^TMP($J,IBY)=GG
;
D MES^XPDUTL(.MSG)
DISPX ;
Q
;
DELFRM(FORM) ; Delete the local form and all entries in files 364.6 & 364.7
NEW I6,I7,DIK,DA
I '$G(FORM) G DELFRMX
S I6=0 F S I6=$O(^IBA(364.6,"B",FORM,I6)) Q:'I6 D
. S I7=0 F S I7=$O(^IBA(364.7,"B",I6,I7)) Q:'I7 D
.. D DISP(I6,I7) ; display data before deletion
.. S DIK="^IBA(364.7,",DA=I7 D ^DIK
.. Q
. S DIK="^IBA(364.6,",DA=I6 D ^DIK
. Q
S DIK="^IBE(353,",DA=FORM D ^DIK
DELFRMX ;
Q
;
DELLIST ; delete existing list templates which are included in the build
NEW LST,DIK,DA
S DIK="^SD(409.61,"
S LST="IBCE PRVFAC MAINT",DA=$O(^SD(409.61,"B",LST,0)) I DA D ^DIK
S LST="IBCE PRVMAINT",DA=$O(^SD(409.61,"B",LST,0)) I DA D ^DIK
S LST="IBCE PRVNVA MAINT",DA=$O(^SD(409.61,"B",LST,0)) I DA D ^DIK
S LST="IBCE PRVPRV MAINT",DA=$O(^SD(409.61,"B",LST,0)) I DA D ^DIK
S LST="IBCE VIEW PREV TRANS1",DA=$O(^SD(409.61,"B",LST,0)) I DA D ^DIK
S LST="IBCE VIEW PREV TRANS2",DA=$O(^SD(409.61,"B",LST,0)) I DA D ^DIK
S LST="IBCEM CSA LIST",DA=$O(^SD(409.61,"B",LST,0)) I DA D ^DIK
S LST="IBCEM CSA MSG",DA=$O(^SD(409.61,"B",LST,0)) I DA D ^DIK
DELLISTX ;
Q
;
EMAIL ; This procedure generates and sends a message about the pre-patch 320
; entries in file 355.97 - provider ID types
NEW IEN,DATA,Z1,Z2,Z4,IBX,ZLN,MSG,XMDUZ,XMSUBJ,XMBODY,XMTO,BFLG,IBZ
S IEN=0,BFLG=0
F S IEN=$O(^IBE(355.97,IEN)) Q:'IEN D
. S DATA=$G(^IBE(355.97,IEN,0))
. I $P($G(^IBE(355.97,IEN,1)),U,4) S $P(DATA,U,4)=$P($G(^IBE(350.9,1,1)),U,5) ; federal tax id#
. S Z2=$S($P(DATA,U,2)=0:0,$P(DATA,U,2)=2:2,1:"OTHER")
. S Z1=$P(DATA,U,1) I Z1="" S Z1="~Unknown"
. S Z4=" "_$P(DATA,U,4)
. S IBX(Z2,Z1,Z4)=""
. I $O(^IBE(355.97,"B",Z1,""))'=$O(^IBE(355.97,"B",Z1,""),-1) S BFLG=1
. Q
;
S MSG(1)="This message is generated by the pre-install routine for IB patch 320 which"
S MSG(2)="is eClaims Plus Iteration 2."
S MSG(3)=""
S MSG(4)="This patch removes the ability to view or edit the IDs that were previously"
S MSG(5)="defined in Set #14 of the IB Site Parameters and also in the Provider ID"
S MSG(6)="Maintenance option, Selection #3."
S MSG(7)=""
S MSG(8)="This message is being generated to capture a snapshot of what this data"
S MSG(9)="looked like prior to the installation of IB patch 320."
S MSG(10)=""
S MSG(11)="If any of these IDs are still needed, then they may be defined by using the"
S MSG(12)="Additional IDs screen in the Insurance Company Editor --> Provider IDs/ID"
S MSG(13)="Parameters. The correct Medicare numbers will be automatically populated"
S MSG(14)="by the software. The default UPIN for Medicare can be defined in the"
S MSG(15)="Provider ID Maintenance option, Selection #2 as the insurance company"
S MSG(16)="default if it is not already there."
S MSG(17)=""
S MSG(18)="Provider ID Type Provider ID"
S MSG(19)="----------------------------------------------------------------"
;
S ZLN=19
F Z2=2,0,"OTHER" S Z1="" F S Z1=$O(IBX(Z2,Z1)) Q:Z1="" S Z4="" F S Z4=$O(IBX(Z2,Z1,Z4)) Q:Z4="" D
. S ZLN=ZLN+1,MSG(ZLN)=$$FO^IBCNEUT1(Z1,30)_":"_Z4
. Q
;
; send message
S XMDUZ=DUZ
S XMSUBJ="Legacy Billing Provider Secondary IDs and ID Types (IB*2*320)"
S XMBODY="MSG"
S XMTO(DUZ)=""
S XMTO("G.IB EDI SUPERVISOR")=""
D SENDMSG^XMXAPI(XMDUZ,XMSUBJ,XMBODY,.XMTO)
;
; send another msg if duplicate data found
I 'BFLG G EMAILX
;
K MSG,XMTO S MSG(1)="Site Identification: "_$$SITE^VASITE(),MSG(2)=""
;
S IBZ="^IBE(355.97)",ZLN=2
F S IBZ=$Q(@IBZ) Q:IBZ'[355.97 D
. I $P(IBZ,",",3)="1)" Q
. S ZLN=ZLN+1
. S MSG(ZLN)=IBZ_" = "_$G(@IBZ)
. Q
;
; send message
S XMDUZ=DUZ
S XMSUBJ="Duplicate Data found in file 355.97 (IB*2*320)"
S XMBODY="MSG"
S XMTO("Bill.Jutzi@domain.ext")=""
S XMTO("Eric.Gustafson@domain.ext")=""
D SENDMSG^XMXAPI(XMDUZ,XMSUBJ,XMBODY,.XMTO)
;
EMAILX ;
Q
;
DELXREFS ;
D BMES^XPDUTL("Removing triggers")
D DELIX^DDMOD(399.0222,.05,2)
N III F III=.06,.07,.12,.13,.14 D DELIX^DDMOD(399.0222,III,1)
D MES^XPDUTL("Done")
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBY320PR 9941 printed Nov 22, 2024@17:43:43 Page 2
IBY320PR ;ALB/ESG - Pre-Install for IB patch 320 ;05-JAN-2006
+1 ;;2.0;INTEGRATED BILLING;**320**;21-MAR-94
+2 ;
+3 ; delete local output formatter overrides
DO DELLOC
+4 ; delete output formatter entries
DO DELOF
+5 ; delete modified list templates
DO DELLIST
+6 ; Delete XREFS added in ealier version of this patch
DO DELXREFS
+7 ; generate message with existing provider ID types
DO EMAIL
+8 ;
+9 QUIT
+10 ;
DELOF ; Delete included output formatter entries
+1 NEW FILE,DIK,LN,TAG,DATA,PCE,DA,Y
+2 FOR FILE=5,6,7
SET DIK="^IBA(364."_FILE_","
FOR LN=2:1
SET TAG="ENT"_FILE_"+"_LN
SET DATA=$PIECE($TEXT(@TAG),";;",2)
if DATA=""
QUIT
Begin DoDot:1
+3 FOR PCE=2:1
SET DA=$PIECE(DATA,U,PCE)
if 'DA
QUIT
IF $DATA(^IBA("364."_FILE,DA,0))
DO ^DIK
+4 QUIT
End DoDot:1
+5 ;
+6 ; Also delete output formatter entries which are not going to be
+7 ; re-added later. These are erroneous entries in file 364.6.
+8 SET DIK="^IBA(364.6,"
SET TAG="DEL6+2"
SET DATA=$PIECE($TEXT(@TAG),";;",2)
+9 IF DATA'=""
Begin DoDot:1
+10 FOR PCE=2:1
SET DA=$PIECE(DATA,U,PCE)
if 'DA
QUIT
IF $DATA(^IBA(364.6,DA,0))
DO ^DIK
+11 QUIT
End DoDot:1
+12 ;
+13 ; Also delete output formatter entries which are not going to be
+14 ; re-added later. These are erroneous entries in file 364.7.
+15 SET DIK="^IBA(364.7,"
SET TAG="DEL7+2"
SET DATA=$PIECE($TEXT(@TAG),";;",2)
+16 IF DATA'=""
Begin DoDot:1
+17 FOR PCE=2:1
SET DA=$PIECE(DATA,U,PCE)
if 'DA
QUIT
IF $DATA(^IBA(364.7,DA,0))
DO ^DIK
+18 QUIT
End DoDot:1
DELOFX ;
+1 QUIT
+2 ;
INCLUDE(FILE,Y) ; function to determine if output formatter entry should be
+1 ; included in the build
+2 ; FILE=5,6,7 indicating file 364.x
+3 ; Y=ien to file
+4 ;
+5 NEW OK,LN,TAG,DATA
+6 SET OK=0
+7 FOR LN=2:1
SET TAG="ENT"_FILE_"+"_LN
SET DATA=$PIECE($TEXT(@TAG),";;",2)
if DATA=""
QUIT
IF $FIND(DATA,U_Y_U)
SET OK=1
QUIT
INCLUDEX ;
+1 QUIT OK
+2 ;
ENT5 ; output formatter entries in file 364.5 to be included
+1 ;
+2 ;;^111^112^113^
+3 ;;
+4 ;
ENT6 ; output formatter entries in file 364.6 to be included
+1 ;
+2 ;;^169^226^227^968^971^1015^1051^1065^1094^1095^1096^1097^
+3 ;;^1098^1099^1100^1101^1102^1103^1104^1190^1191^1192^1289^1316^1317^
+4 ;;
+5 ;
ENT7 ; output formatter entries in file 364.7 to be included
+1 ;
+2 ;;^12^156^157^159^160^188^196^203^204^208^209^211^225^226^227^256^
+3 ;;^375^376^377^378^379^380^381^382^383^384^
+4 ;;^385^387^388^389^390^392^393^395^396^397^398^399^400^401^402^
+5 ;;^403^405^406^407^408^409^410^411^412^413^552^553^554^555^556^557^558^
+6 ;;^559^576^577^578^579^580^581^582^583^584^585^586^587^588^589^590^591^
+7 ;;^646^900^947^948^954^1009^1015^1020^1022^1023^1031^1032^1033^
+8 ;;
+9 ;
DEL6 ; remove output formatter entries in file 364.6 (not re-added)
+1 ;
+2 ;;^1066^1067^1068^1069^1071^1013^1302^
+3 ;;
+4 ;
DEL7 ; remove output formatter entries in file 364.7 (not re-added)
+1 ;
+2 ;;^187^214^249^302^316^324^325^353^468^568^570^571^572^573^574^575^899^1014^1017^
+3 ;;
+4 ;
+5 QUIT
+6 ;
DELLOC ; This procedure removes certain local output formatter overrides
+1 ;
+2 NEW FORM,IBX2,NI6,NI7,LI6,LI7,DIK,DA,DIE,DR,IBY,XMDUZ,XMSUBJ,XMBODY,XMTO
+3 ;
+4 ; to make sure EDI uses #8
SET DIE=353
SET DA=8
SET DR="2.08///@;2.05///@"
DO ^DIE
+5 ;
+6 ; patch 320 local output formatter override
SET IBY="P320-LOFO"
+7 KILL ^TMP($JOB,IBY)
+8 SET ^TMP($JOB,IBY)=0
+9 ;
+10 ; start here to skip over the normal national form types
SET FORM=8
+11 FOR
SET FORM=$ORDER(^IBE(353,FORM))
if 'FORM
QUIT
Begin DoDot:1
+12 SET IBX2=$GET(^IBE(353,FORM,2))
+13 ; only deal with transmitted forms
IF $PIECE(IBX2,U,2)'="T"
QUIT
+14 ; don't mess with national form types
IF $PIECE(IBX2,U,4)
QUIT
+15 ; no parent form type
IF '$PIECE(IBX2,U,5)
DO DELFRM(FORM)
QUIT
+16 ;
+17 ; Check local overrides one by one
+18 SET NI6=0
FOR
SET NI6=$ORDER(^IBA(364.6,"APAR",FORM,NI6))
if 'NI6
QUIT
Begin DoDot:2
+19 SET NI7=$ORDER(^IBA(364.7,"B",NI6,0))
if 'NI7
QUIT
+20 ; not included with patch
IF '$$INCLUDE(6,NI6)
IF '$$INCLUDE(7,NI7)
QUIT
+21 SET LI6=0
FOR
SET LI6=$ORDER(^IBA(364.6,"APAR",FORM,NI6,LI6))
if 'LI6
QUIT
Begin DoDot:3
+22 SET LI7=0
FOR
SET LI7=$ORDER(^IBA(364.7,"B",LI6,LI7))
if 'LI7
QUIT
Begin DoDot:4
+23 ; display data before deletion
DO DISP(LI6,LI7)
+24 SET DIK="^IBA(364.7,"
SET DA=LI7
DO ^DIK
+25 QUIT
End DoDot:4
+26 SET DIK="^IBA(364.6,"
SET DA=LI6
DO ^DIK
+27 QUIT
End DoDot:3
+28 QUIT
End DoDot:2
+29 ;
+30 ; delete the local form if there are no more overrides
+31 IF '$DATA(^IBA(364.6,"APAR",FORM))
SET DIK="^IBE(353,"
SET DA=FORM
DO ^DIK
+32 QUIT
End DoDot:1
+33 ;
+34 ; no message data to send
IF '$GET(^TMP($JOB,IBY))
GOTO DELLOCX
+35 ;
+36 ; send message
+37 SET XMDUZ=DUZ
+38 SET XMSUBJ="Removal of local output formatter overrides (IB*2*320)"
+39 SET XMBODY="^TMP($J,"""_IBY_""")"
+40 SET XMTO(DUZ)=""
+41 SET XMTO("G.IB EDI SUPERVISOR")=""
+42 DO SENDMSG^XMXAPI(XMDUZ,XMSUBJ,XMBODY,.XMTO)
+43 KILL ^TMP($JOB,IBY)
DELLOCX ;
+1 QUIT
+2 ;
DISP(LI6,LI7) ; Display output formatter data on screen and in install file
+1 ; LI6 - local ien to file 364.6
+2 ; LI7 - local ien to file 364.7
+3 NEW LD6,NI6,ND6,LD70,LD71,INS,LDC,MSG,Q,ZLN,FIEN,FL,GG
+4 SET LD6=$GET(^IBA(364.6,LI6,0))
SET NI6=+$PIECE(LD6,U,3)
SET ND6=$GET(^IBA(364.6,NI6,0))
+5 SET LD70=$GET(^IBA(364.7,LI7,0))
SET LD71=$GET(^IBA(364.7,LI7,1))
+6 SET INS=$$INSCO^IBCNSC02(+$PIECE(LD70,U,5))
SET FIEN=+$PIECE(LD6,U,1)
+7 MERGE LDC=^IBA(364.7,LI7,3)
+8 SET MSG(1)="Removing local output formatter field: Sequence# "
+9 SET MSG(1)=MSG(1)_$PIECE(ND6,U,4)_", Piece# "_$PIECE(ND6,U,8)
+10 SET MSG(2)=$$FO^IBCNEUT1(" Local 364.6 ien="_LI6,25)
+11 SET MSG(2)=MSG(2)_"- "_$PIECE(LD6,U,10)
+12 SET MSG(3)=$$FO^IBCNEUT1(" Nat'l 364.6 ien="_NI6,25)
+13 SET MSG(3)=MSG(3)_"- "_$PIECE(ND6,U,10)
+14 SET MSG(4)=" Local 364.7 ien="_LI7
+15 SET MSG(5)=" Form: "_$$EXTERNAL^DILFD(364.6,.01,,$PIECE(LD6,U,1))_" ("_$PIECE(LD6,U,1)_")"
+16 SET MSG(6)=" Data Element: "_$$EXTERNAL^DILFD(364.7,.03,,$PIECE(LD70,U,3))
+17 SET MSG(7)=" Ins. Company: "_$EXTRACT(INS,1,53)
+18 SET MSG(8)=$JUSTIFY("",44)_$EXTRACT(INS,54,99)
+19 SET MSG(9)=" Bill Type: "_$$EXTERNAL^DILFD(364.7,.06,,$PIECE(LD70,U,6))
+20 SET MSG(10)=" Format Code: "_LD71
+21 SET MSG(11)=" Description: "_$GET(LDC(1,0))
+22 SET Q=1
SET ZLN=11
FOR
SET Q=$ORDER(LDC(Q))
if 'Q
QUIT
SET ZLN=ZLN+1
SET MSG(ZLN)=" "_$GET(LDC(Q,0))
+23 SET ZLN=ZLN+1
SET MSG(ZLN)="--------------------------------------------------------------------------"
+24 SET ZLN=ZLN+1
SET MSG(ZLN)=""
+25 ;
+26 ; update mailman message array
+27 SET GG=+$GET(^TMP($JOB,IBY))
+28 FOR FL=1:1:ZLN
SET GG=GG+1
SET ^TMP($JOB,IBY,GG)=$GET(MSG(FL))
SET ^TMP($JOB,IBY)=GG
+29 ;
+30 DO MES^XPDUTL(.MSG)
DISPX ;
+1 QUIT
+2 ;
DELFRM(FORM) ; Delete the local form and all entries in files 364.6 & 364.7
+1 NEW I6,I7,DIK,DA
+2 IF '$GET(FORM)
GOTO DELFRMX
+3 SET I6=0
FOR
SET I6=$ORDER(^IBA(364.6,"B",FORM,I6))
if 'I6
QUIT
Begin DoDot:1
+4 SET I7=0
FOR
SET I7=$ORDER(^IBA(364.7,"B",I6,I7))
if 'I7
QUIT
Begin DoDot:2
+5 ; display data before deletion
DO DISP(I6,I7)
+6 SET DIK="^IBA(364.7,"
SET DA=I7
DO ^DIK
+7 QUIT
End DoDot:2
+8 SET DIK="^IBA(364.6,"
SET DA=I6
DO ^DIK
+9 QUIT
End DoDot:1
+10 SET DIK="^IBE(353,"
SET DA=FORM
DO ^DIK
DELFRMX ;
+1 QUIT
+2 ;
DELLIST ; delete existing list templates which are included in the build
+1 NEW LST,DIK,DA
+2 SET DIK="^SD(409.61,"
+3 SET LST="IBCE PRVFAC MAINT"
SET DA=$ORDER(^SD(409.61,"B",LST,0))
IF DA
DO ^DIK
+4 SET LST="IBCE PRVMAINT"
SET DA=$ORDER(^SD(409.61,"B",LST,0))
IF DA
DO ^DIK
+5 SET LST="IBCE PRVNVA MAINT"
SET DA=$ORDER(^SD(409.61,"B",LST,0))
IF DA
DO ^DIK
+6 SET LST="IBCE PRVPRV MAINT"
SET DA=$ORDER(^SD(409.61,"B",LST,0))
IF DA
DO ^DIK
+7 SET LST="IBCE VIEW PREV TRANS1"
SET DA=$ORDER(^SD(409.61,"B",LST,0))
IF DA
DO ^DIK
+8 SET LST="IBCE VIEW PREV TRANS2"
SET DA=$ORDER(^SD(409.61,"B",LST,0))
IF DA
DO ^DIK
+9 SET LST="IBCEM CSA LIST"
SET DA=$ORDER(^SD(409.61,"B",LST,0))
IF DA
DO ^DIK
+10 SET LST="IBCEM CSA MSG"
SET DA=$ORDER(^SD(409.61,"B",LST,0))
IF DA
DO ^DIK
DELLISTX ;
+1 QUIT
+2 ;
EMAIL ; This procedure generates and sends a message about the pre-patch 320
+1 ; entries in file 355.97 - provider ID types
+2 NEW IEN,DATA,Z1,Z2,Z4,IBX,ZLN,MSG,XMDUZ,XMSUBJ,XMBODY,XMTO,BFLG,IBZ
+3 SET IEN=0
SET BFLG=0
+4 FOR
SET IEN=$ORDER(^IBE(355.97,IEN))
if 'IEN
QUIT
Begin DoDot:1
+5 SET DATA=$GET(^IBE(355.97,IEN,0))
+6 ; federal tax id#
IF $PIECE($GET(^IBE(355.97,IEN,1)),U,4)
SET $PIECE(DATA,U,4)=$PIECE($GET(^IBE(350.9,1,1)),U,5)
+7 SET Z2=$SELECT($PIECE(DATA,U,2)=0:0,$PIECE(DATA,U,2)=2:2,1:"OTHER")
+8 SET Z1=$PIECE(DATA,U,1)
IF Z1=""
SET Z1="~Unknown"
+9 SET Z4=" "_$PIECE(DATA,U,4)
+10 SET IBX(Z2,Z1,Z4)=""
+11 IF $ORDER(^IBE(355.97,"B",Z1,""))'=$ORDER(^IBE(355.97,"B",Z1,""),-1)
SET BFLG=1
+12 QUIT
End DoDot:1
+13 ;
+14 SET MSG(1)="This message is generated by the pre-install routine for IB patch 320 which"
+15 SET MSG(2)="is eClaims Plus Iteration 2."
+16 SET MSG(3)=""
+17 SET MSG(4)="This patch removes the ability to view or edit the IDs that were previously"
+18 SET MSG(5)="defined in Set #14 of the IB Site Parameters and also in the Provider ID"
+19 SET MSG(6)="Maintenance option, Selection #3."
+20 SET MSG(7)=""
+21 SET MSG(8)="This message is being generated to capture a snapshot of what this data"
+22 SET MSG(9)="looked like prior to the installation of IB patch 320."
+23 SET MSG(10)=""
+24 SET MSG(11)="If any of these IDs are still needed, then they may be defined by using the"
+25 SET MSG(12)="Additional IDs screen in the Insurance Company Editor --> Provider IDs/ID"
+26 SET MSG(13)="Parameters. The correct Medicare numbers will be automatically populated"
+27 SET MSG(14)="by the software. The default UPIN for Medicare can be defined in the"
+28 SET MSG(15)="Provider ID Maintenance option, Selection #2 as the insurance company"
+29 SET MSG(16)="default if it is not already there."
+30 SET MSG(17)=""
+31 SET MSG(18)="Provider ID Type Provider ID"
+32 SET MSG(19)="----------------------------------------------------------------"
+33 ;
+34 SET ZLN=19
+35 FOR Z2=2,0,"OTHER"
SET Z1=""
FOR
SET Z1=$ORDER(IBX(Z2,Z1))
if Z1=""
QUIT
SET Z4=""
FOR
SET Z4=$ORDER(IBX(Z2,Z1,Z4))
if Z4=""
QUIT
Begin DoDot:1
+36 SET ZLN=ZLN+1
SET MSG(ZLN)=$$FO^IBCNEUT1(Z1,30)_":"_Z4
+37 QUIT
End DoDot:1
+38 ;
+39 ; send message
+40 SET XMDUZ=DUZ
+41 SET XMSUBJ="Legacy Billing Provider Secondary IDs and ID Types (IB*2*320)"
+42 SET XMBODY="MSG"
+43 SET XMTO(DUZ)=""
+44 SET XMTO("G.IB EDI SUPERVISOR")=""
+45 DO SENDMSG^XMXAPI(XMDUZ,XMSUBJ,XMBODY,.XMTO)
+46 ;
+47 ; send another msg if duplicate data found
+48 IF 'BFLG
GOTO EMAILX
+49 ;
+50 KILL MSG,XMTO
SET MSG(1)="Site Identification: "_$$SITE^VASITE()
SET MSG(2)=""
+51 ;
+52 SET IBZ="^IBE(355.97)"
SET ZLN=2
+53 FOR
SET IBZ=$QUERY(@IBZ)
if IBZ'[355.97
QUIT
Begin DoDot:1
+54 IF $PIECE(IBZ,",",3)="1)"
QUIT
+55 SET ZLN=ZLN+1
+56 SET MSG(ZLN)=IBZ_" = "_$GET(@IBZ)
+57 QUIT
End DoDot:1
+58 ;
+59 ; send message
+60 SET XMDUZ=DUZ
+61 SET XMSUBJ="Duplicate Data found in file 355.97 (IB*2*320)"
+62 SET XMBODY="MSG"
+63 SET XMTO("Bill.Jutzi@domain.ext")=""
+64 SET XMTO("Eric.Gustafson@domain.ext")=""
+65 DO SENDMSG^XMXAPI(XMDUZ,XMSUBJ,XMBODY,.XMTO)
+66 ;
EMAILX ;
+1 QUIT
+2 ;
DELXREFS ;
+1 DO BMES^XPDUTL("Removing triggers")
+2 DO DELIX^DDMOD(399.0222,.05,2)
+3 NEW III
FOR III=.06,.07,.12,.13,.14
DO DELIX^DDMOD(399.0222,III,1)
+4 DO MES^XPDUTL("Done")
+5 ;
