AZAXBILL ;IHS/PHXAO/AEF - FIND 3P BILLS AND CHANGE FROM HCFA-1500 TO UB-92
;;1.0;ANNE'S SPECIAL ROUTINES;;MAR 2, 2004
;
DESC ;ROUTINE DESCRIPTION
;;
;;This routine finds all Arizona Medicaid bills that have been
;;transmitted during the 1/1/04 to 3/31/04 date range and changes
;;the CPT code from 00099 to 99211, the Mode of Export from
;;HCFA-1500-E to UB-92-E V4 and the Bill Type to 131.
;;
;;$$END
;;
EN ;EP -- MAIN ENTRY POINT
; LOOPS THROUGH THE 3P TX STATUS FILE TO FIND THE EXPORTS
; DURING THE TIME FRAME AND THEN FINDS ALL THE BILLS UNDER
; THAT EXPORT
;
N BCNT,DATE,DIR,EXPIEN,FAC,NOW,TCNT,X,Y
;
D ^XBKVAR
D HOME^%ZIS
;
D TXT
;
S DIR(0)="E"
D ^DIR
Q:'Y
;
S NOW=$$NOW
;D ADDREC(NOW)
;
S TCNT=0
S FAC=0
F S FAC=$O(^ABMDTXST(FAC)) Q:'FAC D
. S DATE=3031231.9999
. F S DATE=$O(^ABMDTXST(FAC,"B",DATE)) Q:'DATE Q:DATE>3040331 D
. . S EXPIEN=0
. . F S EXPIEN=$O(^ABMDTXST(FAC,"B",DATE,EXPIEN)) Q:'EXPIEN D
. . . S BCNT=0
. . . D 1BAT(FAC,EXPIEN,.BCNT,NOW)
. . . S TCNT=TCNT+BCNT
;
W !!?5,"TOTAL BILLS PROCESSED: "_TCNT
;
Q
1BAT(FAC,EXPIEN,BCNT,NOW) ;
;----- PROCESS ONE BATCH
;
N BILLIEN,DATA
;
Q:'FAC
Q:'EXPIEN
Q:'NOW
;
;I '$D(^AZAXBILL("B",NOW)) D ADDREC(NOW)
;
S DATA=$G(^ABMDTXST(FAC,EXPIEN,0))
Q:$$MODE($P(DATA,U,2))[837 ;DO ALL BATCHES EXCEPT FOR 837 BATCHES
Q:$$INSURER($P(DATA,U,4))'="ARIZONA MEDICAID"
;
W !!?5,"PROCESSING BATCH #"_FAC_"-"_EXPIEN_" "_$$DATE($P(DATA,U))
;
D CHMOD(FAC,EXPIEN)
;
S BILLIEN=0
F S BILLIEN=$O(^ABMDTXST(FAC,EXPIEN,2,BILLIEN)) Q:'BILLIEN D
. D 1BILL(FAC,BILLIEN,.BCNT,NOW)
W !?5,"NUMBER OF BILLS PROCESSED: "_BCNT
Q
1BILL(FAC,BILLIEN,BCNT,NOW) ;
;----- PROCESS ONE BILL
; EDITS THE EXPORT MODE AND CPT CODES FOR ONE BILL
;
N CODE,CODEIEN,DA,DATA,DIE,DR,MODE,X,Y
;
Q:'FAC
Q:'BILLIEN
Q:'NOW
;
;I '$D(^AZAXBILL("B",NOW)) D ADDREC(NOW)
;
Q:'$D(^ABMDBILL(FAC,BILLIEN,0))
S DATA=$G(^ABMDBILL(FAC,BILLIEN,0))
;Q:$P(DATA,U,2)'=131 ;BILL TYPE MUST BE 131 ; DO ALL BILLS
;Q:$P(DATA,U,4)'="B" ;BILL STATUS MUST BE "BILLED"
Q:$$MODE($P(DATA,U,6))[837 ;DO ALL BILLS EXCEPT 837s
Q:$$INSURER($P(DATA,U,8))'="ARIZONA MEDICAID"
;
D EXP(FAC,BILLIEN)
D CPT(FAC,BILLIEN)
;D ADDBIL(NOW,FAC,BILLIEN)
;
S BCNT=$G(BCNT)+1
Q
CHMOD(FAC,EXPIEN) ;
;----- CHANGE EXPORT MODE IN BATCH
;
N DA,DIE,DR,MODE,X,Y
;
S MODE="UB-92-E V4"
S DA=EXPIEN
S DIE="^ABMDTXST("_FAC_","
S DR=".02///^S X=MODE"
D ^DIE
Q
EXP(FAC,BILLIEN) ;
;----- CHANGE EXPORT MODE AND BILL TYPE IN BILL
;
N DA,DIE,DR,MODE,TYPE,X,Y
;
S TYPE=131
S MODE="UB-92-E V4"
S DA=BILLIEN
S DIE="^ABMDBILL("_FAC_","
S DR=".02///^S X=TYPE;.06///^S X=MODE"
D ^DIE ;*** TESTING - AEF *** COMMENT OUT FOR TESTING
Q
CPT(FAC,BILLIEN) ;
;----- NOW FIND ALL THE 00099 CPT CODES UNDER THE Medical Procedures
; MULTIPLE AND CHANGE THEM TO 99211 AND STUFF REVENUE CODE 510
;
N DA,DIE,DR,CODE,CODEIEN,REVCOD,X,Y
;
S REVCODE=510
S CODEIEN=0
F S CODEIEN=$O(^ABMDBILL(FAC,BILLIEN,27,CODEIEN)) Q:'CODEIEN D
. S CODE=$P($G(^ABMDBILL(FAC,BILLIEN,27,CODEIEN,0)),U)
. Q:+CODE'=99
. S DA(1)=BILLIEN
. S DA=CODEIEN
. S DIE="^ABMDBILL("_FAC_","_DA(1)_",27,"
. S DR=".01///^S X=99211;.02///^S X=REVCOD"
. D ^DIE ;*** TESTING - AEF *** COMMENT OUT FOR TESTING
Q
ADDREC(X) ;
;----- ADD RECORD TO THE AZAX BILL FILE
;
; X = NOW
;
Q
N DA,DD,DIC,DINUM,DO,Y
;
S DINUM=X
S DIC="^AZAXBILL("
S DIC(0)=""
D FILE^DICN
Q
ADDBIL(NOW,FAC,BIL) ;
;----- ADD BILL TO THE AZAX BILL FILE
;
Q
N DA,DD,DIADD,DIC,DO,X,Y
;
S X=FAC_"-"_BIL
S DA(1)=NOW
S DIC="^AZAXBILL("_DA(1)_",1,"
S DIC(0)=""
S DIC("P")=$P(^DD(1991226,1,0),U,2)
S DIADD=1
D FILE^DICN
Q
TXT ;----- PRINT OPTION TEXT
;
N I,X
F I=1:1 S X=$P($T(DESC+I),";",3) Q:X["$$END" W !,X
Q
MODE(X)
;----- RESOLVE EXPORT MODE POINTER
;
N Y
S Y=""
I X S Y=$P($G(^ABMDEXP(X,0)),U)
Q Y
INSURER(X)
;----- RESOLVE INSURER POINTER
;
N Y
S Y=""
I X S Y=$P($G(^AUTNINS(X,0)),U)
Q Y
DATE(X) ;
;----- DATE CONVERSION TO EXTERNAL DATE
;
; X = DATE IN INTERNAL FM FORMAT
;
N Y
S Y=""
I X D
. S Y=X
. D DD^%DT
Q Y
NOW() ;
;----- RETURNS CURRENT DATE/TIME
;
N %,%H,%I,X
D NOW^%DTC
Q %
AZAXBILL ;IHS/PHXAO/AEF - FIND 3P BILLS AND CHANGE FROM HCFA-1500 TO UB-92
+1 ;;1.0;ANNE'S SPECIAL ROUTINES;;MAR 2, 2004
+2 ;
DESC ;ROUTINE DESCRIPTION
+1 ;;
+2 ;;This routine finds all Arizona Medicaid bills that have been
+3 ;;transmitted during the 1/1/04 to 3/31/04 date range and changes
+4 ;;the CPT code from 00099 to 99211, the Mode of Export from
+5 ;;HCFA-1500-E to UB-92-E V4 and the Bill Type to 131.
+6 ;;
+7 ;;$$END
+8 ;;
EN ;EP -- MAIN ENTRY POINT
+1 ; LOOPS THROUGH THE 3P TX STATUS FILE TO FIND THE EXPORTS
+2 ; DURING THE TIME FRAME AND THEN FINDS ALL THE BILLS UNDER
+3 ; THAT EXPORT
+4 ;
+5 NEW BCNT,DATE,DIR,EXPIEN,FAC,NOW,TCNT,X,Y
+6 ;
+7 DO ^XBKVAR
+8 DO HOME^%ZIS
+9 ;
+10 DO TXT
+11 ;
+12 SET DIR(0)="E"
+13 DO ^DIR
+14 IF 'Y
QUIT
+15 ;
+16 SET NOW=$$NOW
+17 ;D ADDREC(NOW)
+18 ;
+19 SET TCNT=0
+20 SET FAC=0
+21 FOR
SET FAC=$ORDER(^ABMDTXST(FAC))
IF 'FAC
QUIT
Begin DoDot:1
+22 SET DATE=3031231.9999
+23 FOR
SET DATE=$ORDER(^ABMDTXST(FAC,"B",DATE))
IF 'DATE
QUIT
IF DATE>3040331
QUIT
Begin DoDot:2
+24 SET EXPIEN=0
+25 FOR
SET EXPIEN=$ORDER(^ABMDTXST(FAC,"B",DATE,EXPIEN))
IF 'EXPIEN
QUIT
Begin DoDot:3
+26 SET BCNT=0
+27 DO 1BAT(FAC,EXPIEN,.BCNT,NOW)
+28 SET TCNT=TCNT+BCNT
End DoDot:3
End DoDot:2
End DoDot:1
+29 ;
+30 WRITE !!?5,"TOTAL BILLS PROCESSED: "_TCNT
+31 ;
+32 QUIT
1BAT(FAC,EXPIEN,BCNT,NOW) ;
+1 ;----- PROCESS ONE BATCH
+2 ;
+3 NEW BILLIEN,DATA
+4 ;
+5 IF 'FAC
QUIT
+6 IF 'EXPIEN
QUIT
+7 IF 'NOW
QUIT
+8 ;
+9 ;I '$D(^AZAXBILL("B",NOW)) D ADDREC(NOW)
+10 ;
+11 SET DATA=$GET(^ABMDTXST(FAC,EXPIEN,0))
+12 ;DO ALL BATCHES EXCEPT FOR 837 BATCHES
IF $$MODE($PIECE(DATA,U,2))[837
QUIT
+13 IF $$INSURER($PIECE(DATA,U,4))'="ARIZONA MEDICAID"
QUIT
+14 ;
+15 WRITE !!?5,"PROCESSING BATCH #"_FAC_"-"_EXPIEN_" "_$$DATE($PIECE(DATA,U))
+16 ;
+17 DO CHMOD(FAC,EXPIEN)
+18 ;
+19 SET BILLIEN=0
+20 FOR
SET BILLIEN=$ORDER(^ABMDTXST(FAC,EXPIEN,2,BILLIEN))
IF 'BILLIEN
QUIT
Begin DoDot:1
+21 DO 1BILL(FAC,BILLIEN,.BCNT,NOW)
End DoDot:1
+22 WRITE !?5,"NUMBER OF BILLS PROCESSED: "_BCNT
+23 QUIT
1BILL(FAC,BILLIEN,BCNT,NOW) ;
+1 ;----- PROCESS ONE BILL
+2 ; EDITS THE EXPORT MODE AND CPT CODES FOR ONE BILL
+3 ;
+4 NEW CODE,CODEIEN,DA,DATA,DIE,DR,MODE,X,Y
+5 ;
+6 IF 'FAC
QUIT
+7 IF 'BILLIEN
QUIT
+8 IF 'NOW
QUIT
+9 ;
+10 ;I '$D(^AZAXBILL("B",NOW)) D ADDREC(NOW)
+11 ;
+12 IF '$DATA(^ABMDBILL(FAC,BILLIEN,0))
QUIT
+13 SET DATA=$GET(^ABMDBILL(FAC,BILLIEN,0))
+14 ;Q:$P(DATA,U,2)'=131 ;BILL TYPE MUST BE 131 ; DO ALL BILLS
+15 ;Q:$P(DATA,U,4)'="B" ;BILL STATUS MUST BE "BILLED"
+16 ;DO ALL BILLS EXCEPT 837s
IF $$MODE($PIECE(DATA,U,6))[837
QUIT
+17 IF $$INSURER($PIECE(DATA,U,8))'="ARIZONA MEDICAID"
QUIT
+18 ;
+19 DO EXP(FAC,BILLIEN)
+20 DO CPT(FAC,BILLIEN)
+21 ;D ADDBIL(NOW,FAC,BILLIEN)
+22 ;
+23 SET BCNT=$GET(BCNT)+1
+24 QUIT
CHMOD(FAC,EXPIEN) ;
+1 ;----- CHANGE EXPORT MODE IN BATCH
+2 ;
+3 NEW DA,DIE,DR,MODE,X,Y
+4 ;
+5 SET MODE="UB-92-E V4"
+6 SET DA=EXPIEN
+7 SET DIE="^ABMDTXST("_FAC_","
+8 SET DR=".02///^S X=MODE"
+9 DO ^DIE
+10 QUIT
EXP(FAC,BILLIEN) ;
+1 ;----- CHANGE EXPORT MODE AND BILL TYPE IN BILL
+2 ;
+3 NEW DA,DIE,DR,MODE,TYPE,X,Y
+4 ;
+5 SET TYPE=131
+6 SET MODE="UB-92-E V4"
+7 SET DA=BILLIEN
+8 SET DIE="^ABMDBILL("_FAC_","
+9 SET DR=".02///^S X=TYPE;.06///^S X=MODE"
+10 ;*** TESTING - AEF *** COMMENT OUT FOR TESTING
DO ^DIE
+11 QUIT
CPT(FAC,BILLIEN) ;
+1 ;----- NOW FIND ALL THE 00099 CPT CODES UNDER THE Medical Procedures
+2 ; MULTIPLE AND CHANGE THEM TO 99211 AND STUFF REVENUE CODE 510
+3 ;
+4 NEW DA,DIE,DR,CODE,CODEIEN,REVCOD,X,Y
+5 ;
+6 SET REVCODE=510
+7 SET CODEIEN=0
+8 FOR
SET CODEIEN=$ORDER(^ABMDBILL(FAC,BILLIEN,27,CODEIEN))
IF 'CODEIEN
QUIT
Begin DoDot:1
+9 SET CODE=$PIECE($GET(^ABMDBILL(FAC,BILLIEN,27,CODEIEN,0)),U)
+10 IF +CODE'=99
QUIT
+11 SET DA(1)=BILLIEN
+12 SET DA=CODEIEN
+13 SET DIE="^ABMDBILL("_FAC_","_DA(1)_",27,"
+14 SET DR=".01///^S X=99211;.02///^S X=REVCOD"
+15 ;*** TESTING - AEF *** COMMENT OUT FOR TESTING
DO ^DIE
End DoDot:1
+16 QUIT
ADDREC(X) ;
+1 ;----- ADD RECORD TO THE AZAX BILL FILE
+2 ;
+3 ; X = NOW
+4 ;
+5 QUIT
+6 NEW DA,DD,DIC,DINUM,DO,Y
+7 ;
+8 SET DINUM=X
+9 SET DIC="^AZAXBILL("
+10 SET DIC(0)=""
+11 DO FILE^DICN
+12 QUIT
ADDBIL(NOW,FAC,BIL) ;
+1 ;----- ADD BILL TO THE AZAX BILL FILE
+2 ;
+3 QUIT
+4 NEW DA,DD,DIADD,DIC,DO,X,Y
+5 ;
+6 SET X=FAC_"-"_BIL
+7 SET DA(1)=NOW
+8 SET DIC="^AZAXBILL("_DA(1)_",1,"
+9 SET DIC(0)=""
+10 SET DIC("P")=$PIECE(^DD(1991226,1,0),U,2)
+11 SET DIADD=1
+12 DO FILE^DICN
+13 QUIT
TXT ;----- PRINT OPTION TEXT
+1 ;
+2 NEW I,X
+3 FOR I=1:1
SET X=$PIECE($TEXT(DESC+I),";",3)
IF X["$$END"
QUIT
WRITE !,X
+4 QUIT
MODE(X) +1 ;----- RESOLVE EXPORT MODE POINTER
+2 ;
+3 NEW Y
+4 SET Y=""
+5 IF X
SET Y=$PIECE($GET(^ABMDEXP(X,0)),U)
+6 QUIT Y
INSURER(X) +1 ;----- RESOLVE INSURER POINTER
+2 ;
+3 NEW Y
+4 SET Y=""
+5 IF X
SET Y=$PIECE($GET(^AUTNINS(X,0)),U)
+6 QUIT Y
DATE(X) ;
+1 ;----- DATE CONVERSION TO EXTERNAL DATE
+2 ;
+3 ; X = DATE IN INTERNAL FM FORMAT
+4 ;
+5 NEW Y
+6 SET Y=""
+7 IF X
Begin DoDot:1
+8 SET Y=X
+9 DO DD^%DT
End DoDot:1
+10 QUIT Y
NOW() ;
+1 ;----- RETURNS CURRENT DATE/TIME
+2 ;
+3 NEW %,%H,%I,X
+4 DO NOW^%DTC
+5 QUIT %
