- 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
