ABMEXLIP ;IHS/PIMC/JLG - Create export of inpatients for a month
;;2.6;IHS 3P BILLING SYSTEM;;NOV 12, 2009
;Pat name in ABMQ(9002274.3,IENS,.01,"E")
;HRN in ABMHRN
;get ADM SVC from ADT in ABMADMSV
;ADM date in ABMQ(....61 DISC date in ABMQ(.....63
;Calculate LOS in ABMLOS
;NAR, CARE, Caid in ABMQ(.....08, and ABMINTYP
;MCAID Plan in ABMPLAN
;PPO, HMO, TRI not available
;PI insurer in ABMQ(....08
;Claim number ABMD0
;AMT BILL A from 3p bill file
;Fields 13 and 15 in AR bill file may be useful. It will take some
;creativeness to get the AMT REC A
W !
K DIRUT
S %DT="AEPX"
S %DT("A")="Enter Start Date: "
D ^%DT
Q:Y=-1
S ABMSTDT=Y
S X1=Y
S X2=-4
D C^%DTC
S ABMDT=X
S %DT="AEPX"
S %DT("A")="Enter End Date: "
D ^%DT
Q:Y=-1
S ABMENDDT=Y
FILEN ;open & write file
S DIR(0)="9002274.5,.47"
S DIR("A")="Enter File Directory"
S DIR("B")=$P($G(^ABMDPARM(DUZ(2),1,4)),"^",7)
D ^DIR K DIR
I Y["^" S POP=1 Q
S ABMXPATH=Y
S DIR(0)="FAO^3:40^K:X'?1A.(1AN,1"" "",1""-"",1""_"") X"
S DIR("A")="Enter Filename for output: "
S DIR("B")="abmxls"_$E(DT,2,7)
S DIR("?")="Please enter name of file."
D ^DIR
Q:$D(DIRUT)
S ABMXFILE=Y
D OPEN^%ZISH("ABMXFILE",ABMXPATH,ABMXFILE,"W")
I POP D G FILEN
.W !,"Output file not opened. Try again."
U IO(0)
W !,"File opened beginning to write export data.",!
U IO
F S ABMDT=$O(^ABMDCLM(DUZ(2),"AD",ABMDT)) Q:'ABMDT!(ABMDT>ABMENDDT) D
.S ABMD0=0
.F S ABMD0=$O(^ABMDCLM(DUZ(2),"AD",ABMDT,ABMD0)) Q:'ABMD0 D
..K ABMQ,ABMB
..S IENS=ABMD0_","
..S DR=".01;.07;.08;.61;.63;65*"
..D GETS^DIQ(9002274.3,IENS,DR,"EI","ABMQ")
..S AD=ABMQ(9002274.3,IENS,.61,"I")
..Q:AD<ABMSTDT!(AD>ABMENDDT)
..S VT=ABMQ(9002274.3,IENS,.07,"I")
..Q:(VT'=111)&(VT'=999)
..K ABMADMSV
..I $D(^ABMDCLM(DUZ(2),ABMD0,11,"AC","P")) D
...S VAIP("D")=+^AUPNVSIT(+$O(^ABMDCLM(DUZ(2),ABMD0,11,"AC","P",0)),0)
...S DFN=ABMQ(9002274.3,IENS,.01,"I")
...D IN5^VADPT
...S ABMADMSV=$P(VAIP(8),U,2)
..I ABMQ(9002274.3,IENS,.08,"I")="" D
...S ABMDONE=0
...K IENS2,IENS4,IENS4SAV,ABMQC
...S ABMD1=0
...F S ABMD1=$O(^ABMDCLM(DUZ(2),ABMD0,13,ABMD1)) Q:'ABMD1 D Q:ABMDONE
....S IENS4=ABMD1_","_IENS
....D GETS^DIQ(9002274.3013,IENS4,".01;.03","EI","ABMQ")
....I "IB"[ABMQ(9002274.3013,IENS4,.03,"I") D
.....S IENS2=ABMQ(9002274.3013,IENS4,.01,"I")_","
.....S ABMDONE=1
.....S ABMINSN=ABMQ(9002274.3013,IENS4,.01,"E")
....E I "C"=ABMQ(9002274.3013,IENS4,.03,"I") D
.....S ABMQC=1
.....S IENS4SAV=IENS4
...I $G(IENS4),'ABMDONE,$G(ABMQC) D
....S IENS2=ABMQ(9002274.3013,IENS4SAV,.01,"I")_","
....S ABMINSN=ABMQ(9002274.3013,IENS4SAV,.01,"E")
..E D
...S IENS2=ABMQ(9002274.3,IENS,.08,"I")_","
...S ABMINSN=ABMQ(9002274.3,IENS,.08,"E")
..Q:IENS2=","
..S ABMINS=+IENS2
..S ABMINTYP=$$GET1^DIQ(9999999.18,IENS2,.21,"I")
..K ABMPLAN
..S ABMCAID=""
..S ABMCARE=""
..S ABMMFD0=$O(^AUPNMCD("B",ABMQ(9002274.3,IENS,.01,"I"),""))
..I ABMMFD0]"" D
...S IENS3=ABMMFD0_","
...S ABMPLAN=$$GET1^DIQ(9000004,IENS3,.11)
..I ABMINTYP="D" S ABMCAID=1
..E I ABMINTYP="R" D
...S ABMCARE=1
..K ABMBILAM,ABMBILRE
..S IENSX=""
..F S IENSX=$O(ABMQ(9002274.3065,IENSX)) Q:'IENSX D
...S ABMBIL=ABMQ(9002274.3065,IENSX,.01,"E")
...S ABMLET=$E(ABMBIL,$L(ABMBIL))
...S IENS2=ABMQ(9002274.3065,IENSX,.01,"I")_","
...S ABMBILAM(ABMLET)=$$GET1^DIQ(9002274.4,IENS2,.21)
...S X=ABMBIL
...S DIC=90050.01
...D ^DIC
...Q:Y=-1
...S IENS2=+Y_","
...D GETS^DIQ(90050.01,IENS2,"13;15",,"ABMB")
...S ABMBILRE(ABMLET)=ABMB(90050.01,IENS2,13)-ABMB(90050.01,IENS2,15)
..S ABMHRN=$$HRN^AUPNPAT(ABMQ(9002274.3,IENS,.01,"I"),DUZ(2))
..S X1=ABMQ(9002274.3,IENS,.63,"I")
..S X2=ABMQ(9002274.3,IENS,.61,"I")
..D ^%DTC
..S ABMLOS=X+1
..S ABMNAR=$S(ABMINS=1184:1,1:"") ;1184 = Beneficiary Indian
..S P="|"
..S ABMEXPS=ABMQ(9002274.3,IENS,.01,"E")_P_ABMHRN_P
..S ABMEXPS=ABMEXPS_$G(ABMADMSV)_P
..S ABMEXPS=ABMEXPS_ABMQ(9002274.3,IENS,.61,"E")_P
..S ABMEXPS=ABMEXPS_ABMQ(9002274.3,IENS,.63,"E")_P_ABMLOS_P
..S ABMEXPS=ABMEXPS_ABMNAR_P_ABMCARE_P_ABMCAID_P
..I $D(ABMPLAN) S ABMEXPS=ABMEXPS_ABMPLAN_P
..E S ABMEXPS=ABMEXPS_P
..S ABMEXPS=ABMEXPS_P_P_P
..I ABMINTYP="P" S ABMEXPS=ABMEXPS_ABMINSN_P
..E S ABMEXPS=ABMEXPS_P
..S ABMEXPS=ABMEXPS_ABMD0_P
..S ABMLET=""
..F S ABMLET=$O(ABMBILAM(ABMLET)) Q:ABMLET="" D
...S ABMEXPS=ABMEXPS_ABMBILAM(ABMLET)_P_ABMBILRE(ABMLET)_P
..W ABMEXPS,!
D CLOSE^%ZISH("ABMXFILE")
W !,"Export file complete."
Q
ABMEXLIP ;IHS/PIMC/JLG - Create export of inpatients for a month
+1 ;;2.6;IHS 3P BILLING SYSTEM;;NOV 12, 2009
+2 ;Pat name in ABMQ(9002274.3,IENS,.01,"E")
+3 ;HRN in ABMHRN
+4 ;get ADM SVC from ADT in ABMADMSV
+5 ;ADM date in ABMQ(....61 DISC date in ABMQ(.....63
+6 ;Calculate LOS in ABMLOS
+7 ;NAR, CARE, Caid in ABMQ(.....08, and ABMINTYP
+8 ;MCAID Plan in ABMPLAN
+9 ;PPO, HMO, TRI not available
+10 ;PI insurer in ABMQ(....08
+11 ;Claim number ABMD0
+12 ;AMT BILL A from 3p bill file
+13 ;Fields 13 and 15 in AR bill file may be useful. It will take some
+14 ;creativeness to get the AMT REC A
+15 WRITE !
+16 KILL DIRUT
+17 SET %DT="AEPX"
+18 SET %DT("A")="Enter Start Date: "
+19 DO ^%DT
+20 IF Y=-1
QUIT
+21 SET ABMSTDT=Y
+22 SET X1=Y
+23 SET X2=-4
+24 DO C^%DTC
+25 SET ABMDT=X
+26 SET %DT="AEPX"
+27 SET %DT("A")="Enter End Date: "
+28 DO ^%DT
+29 IF Y=-1
QUIT
+30 SET ABMENDDT=Y
FILEN ;open & write file
+1 SET DIR(0)="9002274.5,.47"
+2 SET DIR("A")="Enter File Directory"
+3 SET DIR("B")=$PIECE($GET(^ABMDPARM(DUZ(2),1,4)),"^",7)
+4 DO ^DIR
KILL DIR
+5 IF Y["^"
SET POP=1
QUIT
+6 SET ABMXPATH=Y
+7 SET DIR(0)="FAO^3:40^K:X'?1A.(1AN,1"" "",1""-"",1""_"") X"
+8 SET DIR("A")="Enter Filename for output: "
+9 SET DIR("B")="abmxls"_$EXTRACT(DT,2,7)
+10 SET DIR("?")="Please enter name of file."
+11 DO ^DIR
+12 IF $DATA(DIRUT)
QUIT
+13 SET ABMXFILE=Y
+14 DO OPEN^%ZISH("ABMXFILE",ABMXPATH,ABMXFILE,"W")
+15 IF POP
Begin DoDot:1
+16 WRITE !,"Output file not opened. Try again."
End DoDot:1
GOTO FILEN
+17 USE IO(0)
+18 WRITE !,"File opened beginning to write export data.",!
+19 USE IO
+20 FOR
SET ABMDT=$ORDER(^ABMDCLM(DUZ(2),"AD",ABMDT))
IF 'ABMDT!(ABMDT>ABMENDDT)
QUIT
Begin DoDot:1
+21 SET ABMD0=0
+22 FOR
SET ABMD0=$ORDER(^ABMDCLM(DUZ(2),"AD",ABMDT,ABMD0))
IF 'ABMD0
QUIT
Begin DoDot:2
+23 KILL ABMQ,ABMB
+24 SET IENS=ABMD0_","
+25 SET DR=".01;.07;.08;.61;.63;65*"
+26 DO GETS^DIQ(9002274.3,IENS,DR,"EI","ABMQ")
+27 SET AD=ABMQ(9002274.3,IENS,.61,"I")
+28 IF AD<ABMSTDT!(AD>ABMENDDT)
QUIT
+29 SET VT=ABMQ(9002274.3,IENS,.07,"I")
+30 IF (VT'=111)&(VT'=999)
QUIT
+31 KILL ABMADMSV
+32 IF $DATA(^ABMDCLM(DUZ(2),ABMD0,11,"AC","P"))
Begin DoDot:3
+33 SET VAIP("D")=+^AUPNVSIT(+$ORDER(^ABMDCLM(DUZ(2),ABMD0,11,"AC","P",0)),0)
+34 SET DFN=ABMQ(9002274.3,IENS,.01,"I")
+35 DO IN5^VADPT
+36 SET ABMADMSV=$PIECE(VAIP(8),U,2)
End DoDot:3
+37 IF ABMQ(9002274.3,IENS,.08,"I")=""
Begin DoDot:3
+38 SET ABMDONE=0
+39 KILL IENS2,IENS4,IENS4SAV,ABMQC
+40 SET ABMD1=0
+41 FOR
SET ABMD1=$ORDER(^ABMDCLM(DUZ(2),ABMD0,13,ABMD1))
IF 'ABMD1
QUIT
Begin DoDot:4
+42 SET IENS4=ABMD1_","_IENS
+43 DO GETS^DIQ(9002274.3013,IENS4,".01;.03","EI","ABMQ")
+44 IF "IB"[ABMQ(9002274.3013,IENS4,.03,"I")
Begin DoDot:5
+45 SET IENS2=ABMQ(9002274.3013,IENS4,.01,"I")_","
+46 SET ABMDONE=1
+47 SET ABMINSN=ABMQ(9002274.3013,IENS4,.01,"E")
End DoDot:5
+48 IF '$TEST
IF "C"=ABMQ(9002274.3013,IENS4,.03,"I")
Begin DoDot:5
+49 SET ABMQC=1
+50 SET IENS4SAV=IENS4
End DoDot:5
End DoDot:4
IF ABMDONE
QUIT
+51 IF $GET(IENS4)
IF 'ABMDONE
IF $GET(ABMQC)
Begin DoDot:4
+52 SET IENS2=ABMQ(9002274.3013,IENS4SAV,.01,"I")_","
+53 SET ABMINSN=ABMQ(9002274.3013,IENS4SAV,.01,"E")
End DoDot:4
End DoDot:3
+54 IF '$TEST
Begin DoDot:3
+55 SET IENS2=ABMQ(9002274.3,IENS,.08,"I")_","
+56 SET ABMINSN=ABMQ(9002274.3,IENS,.08,"E")
End DoDot:3
+57 IF IENS2=","
QUIT
+58 SET ABMINS=+IENS2
+59 SET ABMINTYP=$$GET1^DIQ(9999999.18,IENS2,.21,"I")
+60 KILL ABMPLAN
+61 SET ABMCAID=""
+62 SET ABMCARE=""
+63 SET ABMMFD0=$ORDER(^AUPNMCD("B",ABMQ(9002274.3,IENS,.01,"I"),""))
+64 IF ABMMFD0]""
Begin DoDot:3
+65 SET IENS3=ABMMFD0_","
+66 SET ABMPLAN=$$GET1^DIQ(9000004,IENS3,.11)
End DoDot:3
+67 IF ABMINTYP="D"
SET ABMCAID=1
+68 IF '$TEST
IF ABMINTYP="R"
Begin DoDot:3
+69 SET ABMCARE=1
End DoDot:3
+70 KILL ABMBILAM,ABMBILRE
+71 SET IENSX=""
+72 FOR
SET IENSX=$ORDER(ABMQ(9002274.3065,IENSX))
IF 'IENSX
QUIT
Begin DoDot:3
+73 SET ABMBIL=ABMQ(9002274.3065,IENSX,.01,"E")
+74 SET ABMLET=$EXTRACT(ABMBIL,$LENGTH(ABMBIL))
+75 SET IENS2=ABMQ(9002274.3065,IENSX,.01,"I")_","
+76 SET ABMBILAM(ABMLET)=$$GET1^DIQ(9002274.4,IENS2,.21)
+77 SET X=ABMBIL
+78 SET DIC=90050.01
+79 DO ^DIC
+80 IF Y=-1
QUIT
+81 SET IENS2=+Y_","
+82 DO GETS^DIQ(90050.01,IENS2,"13;15",,"ABMB")
+83 SET ABMBILRE(ABMLET)=ABMB(90050.01,IENS2,13)-ABMB(90050.01,IENS2,15)
End DoDot:3
+84 SET ABMHRN=$$HRN^AUPNPAT(ABMQ(9002274.3,IENS,.01,"I"),DUZ(2))
+85 SET X1=ABMQ(9002274.3,IENS,.63,"I")
+86 SET X2=ABMQ(9002274.3,IENS,.61,"I")
+87 DO ^%DTC
+88 SET ABMLOS=X+1
+89 ;1184 = Beneficiary Indian
SET ABMNAR=$SELECT(ABMINS=1184:1,1:"")
+90 SET P="|"
+91 SET ABMEXPS=ABMQ(9002274.3,IENS,.01,"E")_P_ABMHRN_P
+92 SET ABMEXPS=ABMEXPS_$GET(ABMADMSV)_P
+93 SET ABMEXPS=ABMEXPS_ABMQ(9002274.3,IENS,.61,"E")_P
+94 SET ABMEXPS=ABMEXPS_ABMQ(9002274.3,IENS,.63,"E")_P_ABMLOS_P
+95 SET ABMEXPS=ABMEXPS_ABMNAR_P_ABMCARE_P_ABMCAID_P
+96 IF $DATA(ABMPLAN)
SET ABMEXPS=ABMEXPS_ABMPLAN_P
+97 IF '$TEST
SET ABMEXPS=ABMEXPS_P
+98 SET ABMEXPS=ABMEXPS_P_P_P
+99 IF ABMINTYP="P"
SET ABMEXPS=ABMEXPS_ABMINSN_P
+100 IF '$TEST
SET ABMEXPS=ABMEXPS_P
+101 SET ABMEXPS=ABMEXPS_ABMD0_P
+102 SET ABMLET=""
+103 FOR
SET ABMLET=$ORDER(ABMBILAM(ABMLET))
IF ABMLET=""
QUIT
Begin DoDot:3
+104 SET ABMEXPS=ABMEXPS_ABMBILAM(ABMLET)_P_ABMBILRE(ABMLET)_P
End DoDot:3
+105 WRITE ABMEXPS,!
End DoDot:2
End DoDot:1
+106 DO CLOSE^%ZISH("ABMXFILE")
+107 WRITE !,"Export file complete."
+108 QUIT
