ABMP2512.m

ABMP2512 ; IHS/SD/SDR - 3P BILLING 2.5 Patch 12 PRE/POST INIT ;  

 ;;2.6;IHS 3P BILLING SYSTEM;;NOV 12, 2009

 ;

POST ;

 D ADDZISH  ;add entries to Zish Send Parameters file

 D ERRCODES  ;new error codes in 3P Error Codes file

 D UFMSPARM  ;set UFMS parameters to YES for all IHS sites

 ;D UASUFACL  ;load ASUFAC/FED LOC file from temp file

 Q

 ;

ADDZISH ;EP - ADD ZISH ENTIRES TO 'ZISH SEND PARAMETERS' FILE

 ;ADD 'ABM UFMS B' BACKGROUND ENTRY

 ;ADD 'ABM UFMS F' FOREGROUND ENTRY

ADDF ;ADD FOREGROUND

 I $D(^%ZIB(9888888.93,"B","ABM UFMS F")) D  Q

 .D BMES^XPDUTL("Found [ABM UFMS F] as a ZISH SEND PARAMETER entry")

 D BMES^XPDUTL("Adding [ABM UFMS F] as a ZISH SEND PARAMETER entry")

 K DIC,DIE,DA,DR,DIR

 S DIC="^%ZIB(9888888.93,"

 S DIC(0)="L"

 S X="ABM UFMS F"

 D ^DIC

 I +Y<0 W !,"UNABLE TO ADD ZISH PARAMETER ENTRY. TRY MANUALLY!!" Q

 K DIC,DIE,DA,DR,DIR,DD,DO,DINUM

 S DIE="^%ZIB(9888888.93,"

 S DA=+Y

 S USERNAME="ufmsuser"

 S PASSWORD="vjrsshn9"

 S SENDCMD="sendto"

 S TYPE="F"

 S TARGETIP="quovadx-ie.ihs.gov"

 S ARGS="-i -u -a"

 S DR=".02///^S X=TARGETIP"

 S DR=DR_";.03///^S X=USERNAME"

 S DR=DR_";.04////^S X=PASSWORD"

 S DR=DR_";.06///^S X=ARGS"

 S DR=DR_";.07///^S X=TYPE"

 S DR=DR_";.08///^S X=SENDCMD"

 D ^DIE

 K DIC,DIE,DA,DR,DIR

ADDB ;ADD BACKGROUND

 I $D(^%ZIB(9888888.93,"B","ABM UFMS B")) D  Q

 .D BMES^XPDUTL("Found [ABM UFMS B] as a ZISH SEND PARAMETER entry")

 D BMES^XPDUTL("Adding [ABM UFMS B] as a ZISH SEND PARAMETER entry")

 K DIC,DIE,DA,DR,DIR

 S DIC="^%ZIB(9888888.93,"

 S DIC(0)="L"

 S X="ABM UFMS B"

 D ^DIC

 I +Y<0 D BMES^XPDUTL("UNABLE TO ADD ZISH PARAMETER ENTRY. TRY MANUALLY!!")

 K DIC,DIE,DA,DR,DIR,DD,DO,DINUM

 S DIE="^%ZIB(9888888.93,"

 S DA=+Y

 S USERNAME="ufmstest"

 S PASSWORD="m6pmt3s3"

 S SENDCMD="sendto"

 S TYPE="B"

 S TARGETIP="quovadx-ie.ihs.gov"

 S ARGS="-i -u -a"

 S DR=".02///^S X=TARGETIP"

 S DR=DR_";.03///^S X=USERNAME"

 S DR=DR_";.04////^S X=PASSWORD"

 S DR=DR_";.06///^S X=ARGS"

 S DR=DR_";.07///^S X=TYPE"

 S DR=DR_";.08///^S X=SENDCMD"

 D ^DIE

 K DIC,DIE,DA,DR,DIR

 Q

ERRCODES ;EP

 ;225 - Insurer missing TIN error

 K DIC,X

 S DIC="^ABMDERR("

 S DIC(0)="LM"

 S DINUM=225

 S X="Insurer missing TIN number"

 S DIC("DR")=".02///Add TIN using Add/Edit Insurer option"

 S DIC("DR")=DIC("DR")_";.03///E"

 K DD,DO

 D FILE^DICN

 D SITE(225)

 ;226 - Insurer with Pseudo TIN warning

 K DIC,X

 S DIC="^ABMDERR("

 S DIC(0)="LM"

 S DINUM=226

 S X="Insurer has pseudo TIN number"

 S DIC("DR")=".02///Add valid TIN using Add/Edit Insurer option"

 S DIC("DR")=DIC("DR")_";.03///W"

 K DD,DO

 D FILE^DICN

 D SITE(226)

 ;227 - ASUFAC missing for parent facility

 K DIC,X

 S DIC="^ABMDERR("

 S DIC(0)="LM"

 S DINUM=227

 S X="ASUFAC missing for parent facility"

 S DIC("DR")=".02///Contact your site manager to get populated"

 S DIC("DR")=DIC("DR")_";.03///E"

 K DD,DO

 D FILE^DICN

 D SITE(227)

 ;228 - ASUFAC missing for visit location

 K DIC,X

 S DIC="^ABMDERR("

 S DIC(0)="LM"

 S DINUM=228

 S X="ASUFAC missing for visit location"

 S DIC("DR")=".02///Contact your site manager to get populated"

 S DIC("DR")=DIC("DR")_";.03///E"

 K DD,DO

 D FILE^DICN

 D SITE(228)

 ;230 - Admitting DX might be needed because clinic is ER

 K DIC,X

 S DIC="^ABMDERR("

 S DIC(0)="LM"

 S DINUM=230

 S X="Clinic is ER and Admitting Dx is missing"

 S DIC("DR")=".02///If needed, populate Admitting Dx"

 S DIC("DR")=DIC("DR")_";.03///W"

 K DD,DO

 D FILE^DICN

 D SITE(230)

 Q

SITE(ABMX) ;Add SITE multiple

 S DUZHOLD=DUZ(2)

 S DUZ(2)=0

 F  S DUZ(2)=$O(^ABMDCLM(DUZ(2))) Q:'+DUZ(2)  D

 .S DIC(0)="LX"

 .S DA(1)=ABMX

 .S DIC="^ABMDERR("_DA(1)_",31,"

 .S DIC("P")=$P(^DD(9002274.04,31,0),U,2)

 .S DINUM=DUZ(2)

 .S X=$P($G(^DIC(4,DUZ(2),0)),U)

 .S DIC("DR")=".03////"_$S(DA(1)=226!(DA(1)=230):"W",1:"E")

 .D ^DIC

 .K DA,DIC,DINUM

 S DUZ(2)=DUZHOLD

 K DUZHOLD,DLAYGO,ABMX

 Q

UFMSPARM ;EP

 S DUZHOLD=$G(DUZ(2))

 S DUZ(2)=1

 F  S DUZ(2)=$O(^ABMDPARM(DUZ(2))) Q:+DUZ(2)=0  D

 .Q:$D(^ABMDPARM(DUZ(2),1))'=10

 .S ABMADIEN=$O(^AUTTLOC(DUZ(2),11,9999999),-1)

 .Q:+ABMADIEN=0

 .K DIE,DIC,X,DR,DA

 .S DIE="^ABMDPARM(DUZ(2),"

 .S DA=1

 .I $P($G(^AUTTLOC(DUZ(2),11,ABMADIEN,0)),U,3)="1" S DR="414////1;415////1;416////5"  ;if affiliation IHS

 .I $P($G(^AUTTLOC(DUZ(2),11,ABMADIEN,0)),U,3)'="1" S DR="414////0;415////0;416////5"  ;if affiliation NOT IHS

 .D ^DIE

 S DUZ(2)=DUZHOLD

 K DUZHOLD,ABMADIEN

 Q

UASUFACL ;EP - load ASUFAC/FED LOC file from temp file

 S ABMI=0

 F  S ABMI=$O(^ABMUAFLT(ABMI)) Q:+ABMI=0  D

 .S ABMREC=$G(^ABMUAFLT(ABMI,0))

 .S ABMASUF=$P(ABMREC,U)

 .S ABMACCTP=$P(ABMREC,U,2)

 .S ABMFLOC=$P(ABMREC,U,3)

 .S ABMLDFN=$O(^AUTTLOC("C",ABMASUF,0))

 .Q:ABMLDFN=0

 .K DIC,DIE,X,Y,DA

 .S DIC="^ABMUAPFL("

 .S DIC(0)="LM"

 .S X="`"_ABMLDFN

 .S DIC("DR")=".02////"_ABMASUF_";.03////"_ABMACCTP_";.04////"_ABMFLOC_";.05////3070501"

 .D ^DIC

 .I Y<0 W !,"ENTRY "_ABMREC_" COULD NOT BE LOADED"

 Q

ABMP2512  ; IHS/SD/SDR - 3P BILLING 2.5 Patch 12 PRE/POST INIT ;  

 +1       ;;2.6;IHS 3P BILLING SYSTEM;;NOV 12, 2009

 +2       ;

POST      ;

 +1       ;add entries to Zish Send Parameters file

           DO ADDZISH

 +2       ;new error codes in 3P Error Codes file

           DO ERRCODES

 +3       ;set UFMS parameters to YES for all IHS sites

           DO UFMSPARM

 +4       ;D UASUFACL  ;load ASUFAC/FED LOC file from temp file

 +5        QUIT 

 +6       ;

ADDZISH   ;EP - ADD ZISH ENTIRES TO 'ZISH SEND PARAMETERS' FILE

 +1       ;ADD 'ABM UFMS B' BACKGROUND ENTRY

 +2       ;ADD 'ABM UFMS F' FOREGROUND ENTRY

ADDF      ;ADD FOREGROUND

 +1        IF $DATA(^%ZIB(9888888.93,"B","ABM UFMS F"))

               Begin DoDot:1

 +2                DO BMES^XPDUTL("Found [ABM UFMS F] as a ZISH SEND PARAMETER entry")

               End DoDot:1

               QUIT 

 +3        DO BMES^XPDUTL("Adding [ABM UFMS F] as a ZISH SEND PARAMETER entry")

 +4        KILL DIC,DIE,DA,DR,DIR

 +5        SET DIC="^%ZIB(9888888.93,"

 +6        SET DIC(0)="L"

 +7        SET X="ABM UFMS F"

 +8        DO ^DIC

 +9        IF +Y<0

               WRITE !,"UNABLE TO ADD ZISH PARAMETER ENTRY. TRY MANUALLY!!"

               QUIT 

 +10       KILL DIC,DIE,DA,DR,DIR,DD,DO,DINUM

 +11       SET DIE="^%ZIB(9888888.93,"

 +12       SET DA=+Y

 +13       SET USERNAME="ufmsuser"

 +14       SET PASSWORD="vjrsshn9"

 +15       SET SENDCMD="sendto"

 +16       SET TYPE="F"

 +17       SET TARGETIP="quovadx-ie.ihs.gov"

 +18       SET ARGS="-i -u -a"

 +19       SET DR=".02///^S X=TARGETIP"

 +20       SET DR=DR_";.03///^S X=USERNAME"

 +21       SET DR=DR_";.04////^S X=PASSWORD"

 +22       SET DR=DR_";.06///^S X=ARGS"

 +23       SET DR=DR_";.07///^S X=TYPE"

 +24       SET DR=DR_";.08///^S X=SENDCMD"

 +25       DO ^DIE

 +26       KILL DIC,DIE,DA,DR,DIR

ADDB      ;ADD BACKGROUND

 +1        IF $DATA(^%ZIB(9888888.93,"B","ABM UFMS B"))

               Begin DoDot:1

 +2                DO BMES^XPDUTL("Found [ABM UFMS B] as a ZISH SEND PARAMETER entry")

               End DoDot:1

               QUIT 

 +3        DO BMES^XPDUTL("Adding [ABM UFMS B] as a ZISH SEND PARAMETER entry")

 +4        KILL DIC,DIE,DA,DR,DIR

 +5        SET DIC="^%ZIB(9888888.93,"

 +6        SET DIC(0)="L"

 +7        SET X="ABM UFMS B"

 +8        DO ^DIC

 +9        IF +Y<0

               DO BMES^XPDUTL("UNABLE TO ADD ZISH PARAMETER ENTRY. TRY MANUALLY!!")

 +10       KILL DIC,DIE,DA,DR,DIR,DD,DO,DINUM

 +11       SET DIE="^%ZIB(9888888.93,"

 +12       SET DA=+Y

 +13       SET USERNAME="ufmstest"

 +14       SET PASSWORD="m6pmt3s3"

 +15       SET SENDCMD="sendto"

 +16       SET TYPE="B"

 +17       SET TARGETIP="quovadx-ie.ihs.gov"

 +18       SET ARGS="-i -u -a"

 +19       SET DR=".02///^S X=TARGETIP"

 +20       SET DR=DR_";.03///^S X=USERNAME"

 +21       SET DR=DR_";.04////^S X=PASSWORD"

 +22       SET DR=DR_";.06///^S X=ARGS"

 +23       SET DR=DR_";.07///^S X=TYPE"

 +24       SET DR=DR_";.08///^S X=SENDCMD"

 +25       DO ^DIE

 +26       KILL DIC,DIE,DA,DR,DIR

 +27       QUIT 

ERRCODES  ;EP

 +1       ;225 - Insurer missing TIN error

 +2        KILL DIC,X

 +3        SET DIC="^ABMDERR("

 +4        SET DIC(0)="LM"

 +5        SET DINUM=225

 +6        SET X="Insurer missing TIN number"

 +7        SET DIC("DR")=".02///Add TIN using Add/Edit Insurer option"

 +8        SET DIC("DR")=DIC("DR")_";.03///E"

 +9        KILL DD,DO

 +10       DO FILE^DICN

 +11       DO SITE(225)

 +12      ;226 - Insurer with Pseudo TIN warning

 +13       KILL DIC,X

 +14       SET DIC="^ABMDERR("

 +15       SET DIC(0)="LM"

 +16       SET DINUM=226

 +17       SET X="Insurer has pseudo TIN number"

 +18       SET DIC("DR")=".02///Add valid TIN using Add/Edit Insurer option"

 +19       SET DIC("DR")=DIC("DR")_";.03///W"

 +20       KILL DD,DO

 +21       DO FILE^DICN

 +22       DO SITE(226)

 +23      ;227 - ASUFAC missing for parent facility

 +24       KILL DIC,X

 +25       SET DIC="^ABMDERR("

 +26       SET DIC(0)="LM"

 +27       SET DINUM=227

 +28       SET X="ASUFAC missing for parent facility"

 +29       SET DIC("DR")=".02///Contact your site manager to get populated"

 +30       SET DIC("DR")=DIC("DR")_";.03///E"

 +31       KILL DD,DO

 +32       DO FILE^DICN

 +33       DO SITE(227)

 +34      ;228 - ASUFAC missing for visit location

 +35       KILL DIC,X

 +36       SET DIC="^ABMDERR("

 +37       SET DIC(0)="LM"

 +38       SET DINUM=228

 +39       SET X="ASUFAC missing for visit location"

 +40       SET DIC("DR")=".02///Contact your site manager to get populated"

 +41       SET DIC("DR")=DIC("DR")_";.03///E"

 +42       KILL DD,DO

 +43       DO FILE^DICN

 +44       DO SITE(228)

 +45      ;230 - Admitting DX might be needed because clinic is ER

 +46       KILL DIC,X

 +47       SET DIC="^ABMDERR("

 +48       SET DIC(0)="LM"

 +49       SET DINUM=230

 +50       SET X="Clinic is ER and Admitting Dx is missing"

 +51       SET DIC("DR")=".02///If needed, populate Admitting Dx"

 +52       SET DIC("DR")=DIC("DR")_";.03///W"

 +53       KILL DD,DO

 +54       DO FILE^DICN

 +55       DO SITE(230)

 +56       QUIT 

SITE(ABMX) ;Add SITE multiple

 +1        SET DUZHOLD=DUZ(2)

 +2        SET DUZ(2)=0

 +3        FOR 

               SET DUZ(2)=$ORDER(^ABMDCLM(DUZ(2)))

               IF '+DUZ(2)

                   QUIT 

               Begin DoDot:1

 +4                SET DIC(0)="LX"

 +5                SET DA(1)=ABMX

 +6                SET DIC="^ABMDERR("_DA(1)_",31,"

 +7                SET DIC("P")=$PIECE(^DD(9002274.04,31,0),U,2)

 +8                SET DINUM=DUZ(2)

 +9                SET X=$PIECE($GET(^DIC(4,DUZ(2),0)),U)

 +10               SET DIC("DR")=".03////"_$SELECT(DA(1)=226!(DA(1)=230):"W",1:"E")

 +11               DO ^DIC

 +12               KILL DA,DIC,DINUM

               End DoDot:1

 +13       SET DUZ(2)=DUZHOLD

 +14       KILL DUZHOLD,DLAYGO,ABMX

 +15       QUIT 

UFMSPARM  ;EP

 +1        SET DUZHOLD=$GET(DUZ(2))

 +2        SET DUZ(2)=1

 +3        FOR 

               SET DUZ(2)=$ORDER(^ABMDPARM(DUZ(2)))

               IF +DUZ(2)=0

                   QUIT 

               Begin DoDot:1

 +4                IF $DATA(^ABMDPARM(DUZ(2),1))'=10

                       QUIT 

 +5                SET ABMADIEN=$ORDER(^AUTTLOC(DUZ(2),11,9999999),-1)

 +6                IF +ABMADIEN=0

                       QUIT 

 +7                KILL DIE,DIC,X,DR,DA

 +8                SET DIE="^ABMDPARM(DUZ(2),"

 +9                SET DA=1

 +10      ;if affiliation IHS

                   IF $PIECE($GET(^AUTTLOC(DUZ(2),11,ABMADIEN,0)),U,3)="1"

                       SET DR="414////1;415////1;416////5"

 +11      ;if affiliation NOT IHS

                   IF $PIECE($GET(^AUTTLOC(DUZ(2),11,ABMADIEN,0)),U,3)'="1"

                       SET DR="414////0;415////0;416////5"

 +12               DO ^DIE

               End DoDot:1

 +13       SET DUZ(2)=DUZHOLD

 +14       KILL DUZHOLD,ABMADIEN

 +15       QUIT 

UASUFACL  ;EP - load ASUFAC/FED LOC file from temp file

 +1        SET ABMI=0

 +2        FOR 

               SET ABMI=$ORDER(^ABMUAFLT(ABMI))

               IF +ABMI=0

                   QUIT 

               Begin DoDot:1

 +3                SET ABMREC=$GET(^ABMUAFLT(ABMI,0))

 +4                SET ABMASUF=$PIECE(ABMREC,U)

 +5                SET ABMACCTP=$PIECE(ABMREC,U,2)

 +6                SET ABMFLOC=$PIECE(ABMREC,U,3)

 +7                SET ABMLDFN=$ORDER(^AUTTLOC("C",ABMASUF,0))

 +8                IF ABMLDFN=0

                       QUIT 

 +9                KILL DIC,DIE,X,Y,DA

 +10               SET DIC="^ABMUAPFL("

 +11               SET DIC(0)="LM"

 +12               SET X="`"_ABMLDFN

 +13               SET DIC("DR")=".02////"_ABMASUF_";.03////"_ABMACCTP_";.04////"_ABMFLOC_";.05////3070501"

 +14               DO ^DIC

 +15               IF Y<0

                       WRITE !,"ENTRY "_ABMREC_" COULD NOT BE LOADED"

               End DoDot:1

 +16       QUIT