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