ABMP2513.m

ABMP2513 ; IHS/SD/SDR - 3P BILLING 2.5 Patch 13 PRE/POST INIT ;  

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

 ;

POST ;

 D ADDZISH  ;add entries to Zish Send Parameters file

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

 D ECODES  ;new codes for patch 13

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

 D QUES  ;add question 20 (block 19) to 1500 (08/05)

 D POADFLT  ;set default for POA field in 3P Parameters

 ;D TASK  ;task re-export to run  12/4/07 don't task, just run

 ;D FROMDT^ABMPUEXT  ;re-export--will be done prior to A/R install manually

 Q

 ;

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

 ;ADD 'ABM UFMS B' BACKGROUND ENTRY

 ;ADD 'ABM UFMS F' FOREGROUND ENTRY

 D ADDF

 D ADDB

 Q

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

 .K DIC,DIE,DA,DR,DIR

 .S DIC="^%ZIB(9888888.93,"

 .S DIC(0)="L"

 .S X="ABM UFMS F"

 .D ^DIC

 .S DIE="^%ZIB(9888888.93,"

 .S DA=+Y

 .S USERNAME="ufmsuser"

 .S PASSWORD="vjrsshn9"

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

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

 .D ^DIE

 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

 Q

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

 .K DIC,DIE,DA,DR,DIR

 .S DIC="^%ZIB(9888888.93,"

 .S DIC(0)="L"

 .S X="ABM UFMS B"

 .D ^DIC

 .S DIE="^%ZIB(9888888.93,"

 .S DA=+Y

 .S USERNAME="ufmsuser"

 .S PASSWORD="vjrsshn9"

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

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

 .D ^DIE

 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="ufmsuser"

 S PASSWORD="vjrsshn9"

 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

QUES ;EP

 K DIC,DIE,DA,DR,X,Y

 S DIE="^ABMDEXP("

 S DA=27

 S DR=".08////1,2,3,4B,5,7,9,10,12B,13,15,20,22,34,35,19,25"

 D ^DIE

 Q

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

 .K DIE,DIC,X,DR,DA

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

 .S DA=1

 .S DR="213////Y"  ;POA default to yes

 .D ^DIE

 S DUZ(2)=DUZHOLD

 K DUZHOLD,ABMADIEN

 Q

ECODES ;EP

 ;231 - Present on Admission (POA) indicator missing

 K DIC,X

 S DIC="^ABMDERR("

 S DIC(0)="LM"

 S DINUM=231

 S X="PRESENT ON ADMISSION (POA) INDICATOR MISSING"

 S DIC("DR")=".02///Populate POA for inpatient DXs on page 5A"

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

 K DD,DO

 D FILE^DICN

 D SITE(231)

 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)=0  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)=225!(DA(1)=226)!(DA(1)=230):"W",1:"E")

 .D ^DIC

 .K DA,DIC,DINUM

 S DUZ(2)=DUZHOLD

 K DUZHOLD,DLAYGO,ABMX

 Q

TASK ;EP

 S ZTRTN="FROMDT^ABMPUEXT"

 S ZTDESC="3P UFMS RE-EXPORT"

 ;S ZTSAVE("ABM*")=""

 S ZTIO=""

 S ZTPRI=5

 S ZTDTH=DT_"."_22  ;install day at 10:00pm

 K ZTSK

 D ^%ZTLOAD

 W:$G(ZTSK) !,"Task # ",ZTSK," queued to run Re-Export at 10:00pm",!

 Q

ABMP2513  ; IHS/SD/SDR - 3P BILLING 2.5 Patch 13 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^ABMP2512

 +3       ;new codes for patch 13

           DO ECODES

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

           DO UFMSPARM^ABMP2512

 +5       ;add question 20 (block 19) to 1500 (08/05)

           DO QUES

 +6       ;set default for POA field in 3P Parameters

           DO POADFLT

 +7       ;D TASK  ;task re-export to run  12/4/07 don't task, just run

 +8       ;D FROMDT^ABMPUEXT  ;re-export--will be done prior to A/R install manually

 +9        QUIT 

 +10      ;

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

 +1       ;ADD 'ABM UFMS B' BACKGROUND ENTRY

 +2       ;ADD 'ABM UFMS F' FOREGROUND ENTRY

 +3        DO ADDF

 +4        DO ADDB

 +5        QUIT 

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

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

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

 +5                SET DIC(0)="L"

 +6                SET X="ABM UFMS F"

 +7                DO ^DIC

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

 +9                SET DA=+Y

 +10               SET USERNAME="ufmsuser"

 +11               SET PASSWORD="vjrsshn9"

 +12               SET DR=".03///^S X=USERNAME"

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

 +14               DO ^DIE

               End DoDot:1

               QUIT 

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

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

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

 +18       SET DIC(0)="L"

 +19       SET X="ABM UFMS F"

 +20       DO ^DIC

 +21       IF +Y<0

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

               QUIT 

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

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

 +24       SET DA=+Y

 +25       SET USERNAME="ufmsuser"

 +26       SET PASSWORD="vjrsshn9"

 +27       SET SENDCMD="sendto"

 +28       SET TYPE="F"

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

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

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

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

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

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

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

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

 +37       DO ^DIE

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

 +39       QUIT 

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

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

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

 +5                SET DIC(0)="L"

 +6                SET X="ABM UFMS B"

 +7                DO ^DIC

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

 +9                SET DA=+Y

 +10               SET USERNAME="ufmsuser"

 +11               SET PASSWORD="vjrsshn9"

 +12               SET DR=".03///^S X=USERNAME"

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

 +14               DO ^DIE

               End DoDot:1

               QUIT 

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

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

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

 +18       SET DIC(0)="L"

 +19       SET X="ABM UFMS B"

 +20       DO ^DIC

 +21       IF +Y<0

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

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

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

 +24       SET DA=+Y

 +25       SET USERNAME="ufmsuser"

 +26       SET PASSWORD="vjrsshn9"

 +27       SET SENDCMD="sendto"

 +28       SET TYPE="B"

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

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

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

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

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

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

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

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

 +37       DO ^DIE

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

 +39       QUIT 

QUES      ;EP

 +1        KILL DIC,DIE,DA,DR,X,Y

 +2        SET DIE="^ABMDEXP("

 +3        SET DA=27

 +4        SET DR=".08////1,2,3,4B,5,7,9,10,12B,13,15,20,22,34,35,19,25"

 +5        DO ^DIE

 +6        QUIT 

POADFLT   ;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                KILL DIE,DIC,X,DR,DA

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

 +7                SET DA=1

 +8       ;POA default to yes

                   SET DR="213////Y"

 +9                DO ^DIE

               End DoDot:1

 +10       SET DUZ(2)=DUZHOLD

 +11       KILL DUZHOLD,ABMADIEN

 +12       QUIT 

ECODES    ;EP

 +1       ;231 - Present on Admission (POA) indicator missing

 +2        KILL DIC,X

 +3        SET DIC="^ABMDERR("

 +4        SET DIC(0)="LM"

 +5        SET DINUM=231

 +6        SET X="PRESENT ON ADMISSION (POA) INDICATOR MISSING"

 +7        SET DIC("DR")=".02///Populate POA for inpatient DXs on page 5A"

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

 +9        KILL DD,DO

 +10       DO FILE^DICN

 +11       DO SITE(231)

 +12       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)=0

                   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)=225!(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 

TASK      ;EP

 +1        SET ZTRTN="FROMDT^ABMPUEXT"

 +2        SET ZTDESC="3P UFMS RE-EXPORT"

 +3       ;S ZTSAVE("ABM*")=""

 +4        SET ZTIO=""

 +5        SET ZTPRI=5

 +6       ;install day at 10:00pm

           SET ZTDTH=DT_"."_22

 +7        KILL ZTSK

 +8        DO ^%ZTLOAD

 +9        IF $GET(ZTSK)

               WRITE !,"Task # ",ZTSK," queued to run Re-Export at 10:00pm",!

 +10       QUIT