ABMDRFE3 ; IHS/ASDST/DMJ - CPT Management Reports for AK ;
;;2.6;IHS 3P BILLING SYSTEM;;NOV 12, 2009
;
; IHS/SD/SDR - v2.6 CSV
;
S IOP=ABM("IOP") D ^%ZIS Q:$G(POP) U IO W:$D(ABM("PRINT",16)) @ABM("PRINT",16)
S ABM("PG")=0
S ABM(1)=$S(ABM("CAT")=1:90000,ABM("CAT")=2:10000,ABM("CAT")=3:70000,1:80000),ABM(1)=ABM(1)-1
S ABM(2)=$S(ABM("CAT")=1:99999,ABM("CAT")=2:69999,ABM("CAT")=3:79999,1:89999)
S IOP=ABM("IOP") D ^%ZIS
D HDB G XIT:$D(DUOUT)!$D(DTOUT)!$D(DIROUT)
S ABM=ABM(1) F S ABM=$O(^ICPT(ABM)) Q:'ABM!(ABM>ABM(2)) D Q:$D(DUOUT)!$D(DTOUT)!$D(DIROUT)
.Q:$P($$CPT^ABMCVAPI(ABM,""),U,7)=1 ;CSV-c
.I $Y>(IOSL-7) D HD Q:$D(DUOUT)!$D(DTOUT)!$D(DIROUT)
.I ABM("CAT")=2,$D(^ABMDFEE(ABM("FEE"),11,ABM,0)) S ABMU(1)="?110"_U_$J($FN(($P(^(0),U,2)*1.25),",",2),9) S:$D(^ABMDFEE(ABM("FEE"),23,ABM,0)) ABMU(2)="?122"_U_$J($FN(($P(^(0),U,2)*1.25),",",2),9)
.E I $D(^ABMDFEE(ABM("FEE"),11,ABM,0)) S ABMU(1)="?122"_U_$J($FN($P(^(0),U,2)*1.25,",",2),9)
.E I $D(^ABMDFEE(ABM("FEE"),15,ABM,0)) S ABMU(1)="?122"_U_$J($FN($P(^(0),U,2)*1.25,",",2),9)
.E I $D(^ABMDFEE(ABM("FEE"),17,ABM,0)) S ABMU(1)="?122"_U_$J($FN($P(^(0),U,2)*1.25,",",2),9)
.E I $D(^ABMDFEE(ABM("FEE"),19,ABM,0)) S ABMU(1)="?122"_U_$J($FN($P(^(0),U,2)*1.25,",",2),9)
.;start CSV-c
.S ABMU("TXT")=""
.D IHSCPTD^ABMCVAPI($P(ABM("X0"),U),ABMZCPTD,"","")
.S ABMU("CP")=0
.F S ABMU("CP")=$O(ABMZCPTD(ABMU("CP"))) Q:'$D(ABMZCPTD(ABMU("CP"))) D
..S ABMU("TXT")=ABMU("TXT")_ABMZCPTD(ABMU("CP"))_" "
.;end CSV-c
.S ABMU("TXT")=ABM_" - "_ABMU("TXT")
.;start CSV-c
.S ABM(3)=0
.F I=1:1 S ABM(3)=$O(^ICPT(ABM,"ICD",ABM(3))) Q:'ABM(3) Q:'$D(^ICD0(ABM(3),0)) S ABMU("2TXT",I)=$P($$ICDOP^ABMCVAPI(ABM(3),""),U,2)_" - "_$E($P($$ICDOP^ABMCVAPI(ABM(3),""),U,5),1,30)
.;end CSV-c
.I $D(ABMU("2TXT",1)) S ABMU("2TXT")=ABMU("2TXT",1),ABMU("2LM")=70,ABMU("2RM")=108,ABMU("2TAB")=-6
.S ABMU("LM")=0,ABMU("RM")=65,ABMU("TAB")=-10
.D PRTTXT
;
XIT D POUT^ABMDRUTL,^%ZISC
K ABM
Q
;
PRTTXT ; UTIL FOR WRAP-AROUND
W !
S ABMU("TAB")=$S($D(ABMU("TAB")):ABMU("TAB"),1:0),ABMU("LNG")=ABMU("RM")-ABMU("LM")
I $D(ABMU("2TXT")) S ABMU("2TAB")=$S($D(ABMU("2TAB")):ABMU("2TAB"),1:0),ABMU("2LNG")=ABMU("2RM")-ABMU("2LM")
F ABMU("Q")=1:1 Q:(ABMU("TXT")=""!(" "[ABMU("TXT")))&'$D(ABMU("2TXT")) D PRTTXT2
QIT K ABMU
Q
;
PRTTXT2 K ABMU("FLG") I $L(ABMU("TXT"))<ABMU("LNG") S ABMU("F")=ABMU("TXT"),ABMU("TXT")="" G PRTTXT3
S ABMU("FLG")="" F ABMU("C")=ABMU("LNG"):-1:1 S ABMU("L")=$E(ABMU("TXT"),ABMU("C")) Q:ABMU("L")=" "!(ABMU("L")="-")!(ABMU("L")="\")!(ABMU("L")=",")!(ABMU("L")="/")
S ABMU("F")=$E(ABMU("TXT"),1,ABMU("C")-1),ABMU("TXT")=$E(ABMU("TXT"),ABMU("C")+1,255)
K:" "[ABMU("TXT")!(ABMU("TXT")="")!(ABMU("TXT")=" ") ABMU("FLG")
;
PRTTXT3 I $D(ABMU("2TXT")) D 2
W ?ABMU("LM"),ABMU("F") I $D(ABMU("2TXT")) W ?ABMU("2LM"),ABMU("2F")
I ABMU("Q")=1 F ABMU("I")=1:1 Q:'$D(ABMU(ABMU("I"))) W @$P(ABMU(ABMU("I")),U),$P(ABMU(ABMU("I")),U,2)
W:$D(ABMU("FLG")) ! S ABMU("LM")=ABMU("LM")-ABMU("TAB"),ABMU("LNG")=ABMU("LNG")+ABMU("TAB"),ABMU("TAB")=0
I $D(ABMU("2TXT")) S ABMU("2LM")=ABMU("2LM")-ABMU("2TAB"),ABMU("2LNG")=ABMU("2LNG")+ABMU("2TAB"),ABMU("2TAB")=0
Q
;
2 I $D(ABMU("2TXT",ABMU("Q"))) S ABMU("2F")=ABMU("2TXT",ABMU("Q")),ABMU("FLG")=""
E K ABMU("2TXT")
Q
;
HD D PAZ^ABMDRUTL Q:$D(DTOUT)!$D(DUOUT)!$D(DIROUT)
HDB W:$D(IOF) @IOF S ABM("PG")=ABM("PG")+1
W !!!,"Date: " S Y=DT X ^DD("DD") W Y
I $D(ABM("S")) S ABM("NMM")="~~~~~~~~~~ "_ABM("S")_" LISTING (ALASKA) - "_ABM("NM")_" ~~~~~~~~~~"
W ?132-$L(ABM("NMM"))\2,ABM("NMM")
W ?122,"Page: ",ABM("PG")
I ABM("CAT")=2 W !,"CPT",?70,"ICD CORRESPONDING",?114,"FEE",?121,"ANESTHESIA",!,"CODE - CPT DESCRIPTION",?70,"CODE - ICD DESCRIPTION",?113,"AMOUNT",?125,"FEE"
E W !,"CPT",?70,"ICD CORRESPONDING",?126,"FEE",!,"CODE - CPT DESCRIPTION",?70,"CODE - ICD DESCRIPTION",?124,"AMOUNT"
S ABM("H")="",$P(ABM("H"),"=",132)="" W !,ABM("H")
Q
ABMDRFE3 ; IHS/ASDST/DMJ - CPT Management Reports for AK ;
+1 ;;2.6;IHS 3P BILLING SYSTEM;;NOV 12, 2009
+2 ;
+3 ; IHS/SD/SDR - v2.6 CSV
+4 ;
+5 SET IOP=ABM("IOP")
DO ^%ZIS
IF $GET(POP)
QUIT
USE IO
IF $DATA(ABM("PRINT",16))
WRITE @ABM("PRINT",16)
+6 SET ABM("PG")=0
+7 SET ABM(1)=$SELECT(ABM("CAT")=1:90000,ABM("CAT")=2:10000,ABM("CAT")=3:70000,1:80000)
SET ABM(1)=ABM(1)-1
+8 SET ABM(2)=$SELECT(ABM("CAT")=1:99999,ABM("CAT")=2:69999,ABM("CAT")=3:79999,1:89999)
+9 SET IOP=ABM("IOP")
DO ^%ZIS
+10 DO HDB
IF $DATA(DUOUT)!$DATA(DTOUT)!$DATA(DIROUT)
GOTO XIT
+11 SET ABM=ABM(1)
FOR
SET ABM=$ORDER(^ICPT(ABM))
IF 'ABM!(ABM>ABM(2))
QUIT
Begin DoDot:1
+12 ;CSV-c
IF $PIECE($$CPT^ABMCVAPI(ABM,""),U,7)=1
QUIT
+13 IF $Y>(IOSL-7)
DO HD
IF $DATA(DUOUT)!$DATA(DTOUT)!$DATA(DIROUT)
QUIT
+14 IF ABM("CAT")=2
IF $DATA(^ABMDFEE(ABM("FEE"),11,ABM,0))
SET ABMU(1)="?110"_U_$JUSTIFY($FNUMBER(($PIECE(^(0),U,2)*1.25),",",2),9)
IF $DATA(^ABMDFEE(ABM("FEE"),23,ABM,0))
SET ABMU(2)="?122"_U_$JUSTIFY($FNUMBER(($PIECE(^(0),U,2)*1.25),",",2),9)
+15 IF '$TEST
IF $DATA(^ABMDFEE(ABM("FEE"),11,ABM,0))
SET ABMU(1)="?122"_U_$JUSTIFY($FNUMBER($PIECE(^(0),U,2)*1.25,",",2),9)
+16 IF '$TEST
IF $DATA(^ABMDFEE(ABM("FEE"),15,ABM,0))
SET ABMU(1)="?122"_U_$JUSTIFY($FNUMBER($PIECE(^(0),U,2)*1.25,",",2),9)
+17 IF '$TEST
IF $DATA(^ABMDFEE(ABM("FEE"),17,ABM,0))
SET ABMU(1)="?122"_U_$JUSTIFY($FNUMBER($PIECE(^(0),U,2)*1.25,",",2),9)
+18 IF '$TEST
IF $DATA(^ABMDFEE(ABM("FEE"),19,ABM,0))
SET ABMU(1)="?122"_U_$JUSTIFY($FNUMBER($PIECE(^(0),U,2)*1.25,",",2),9)
+19 ;start CSV-c
+20 SET ABMU("TXT")=""
+21 DO IHSCPTD^ABMCVAPI($PIECE(ABM("X0"),U),ABMZCPTD,"","")
+22 SET ABMU("CP")=0
+23 FOR
SET ABMU("CP")=$ORDER(ABMZCPTD(ABMU("CP")))
IF '$DATA(ABMZCPTD(ABMU("CP")))
QUIT
Begin DoDot:2
+24 SET ABMU("TXT")=ABMU("TXT")_ABMZCPTD(ABMU("CP"))_" "
End DoDot:2
+25 ;end CSV-c
+26 SET ABMU("TXT")=ABM_" - "_ABMU("TXT")
+27 ;start CSV-c
+28 SET ABM(3)=0
+29 FOR I=1:1
SET ABM(3)=$ORDER(^ICPT(ABM,"ICD",ABM(3)))
IF 'ABM(3)
QUIT
IF '$DATA(^ICD0(ABM(3),0))
QUIT
SET ABMU("2TXT",I)=$PIECE($$ICDOP^ABMCVAPI(ABM(3),""),U,2)_" - "_$EXTRACT($PIECE($$ICDOP^ABMCVAPI(ABM(3),""),U,5),1,30)
+30 ;end CSV-c
+31 IF $DATA(ABMU("2TXT",1))
SET ABMU("2TXT")=ABMU("2TXT",1)
SET ABMU("2LM")=70
SET ABMU("2RM")=108
SET ABMU("2TAB")=-6
+32 SET ABMU("LM")=0
SET ABMU("RM")=65
SET ABMU("TAB")=-10
+33 DO PRTTXT
End DoDot:1
IF $DATA(DUOUT)!$DATA(DTOUT)!$DATA(DIROUT)
QUIT
+34 ;
XIT DO POUT^ABMDRUTL
DO ^%ZISC
+1 KILL ABM
+2 QUIT
+3 ;
PRTTXT ; UTIL FOR WRAP-AROUND
+1 WRITE !
+2 SET ABMU("TAB")=$SELECT($DATA(ABMU("TAB")):ABMU("TAB"),1:0)
SET ABMU("LNG")=ABMU("RM")-ABMU("LM")
+3 IF $DATA(ABMU("2TXT"))
SET ABMU("2TAB")=$SELECT($DATA(ABMU("2TAB")):ABMU("2TAB"),1:0)
SET ABMU("2LNG")=ABMU("2RM")-ABMU("2LM")
+4 FOR ABMU("Q")=1:1
IF (ABMU("TXT")=""!(" "[ABMU("TXT")))&'$DATA(ABMU("2TXT"))
QUIT
DO PRTTXT2
QIT KILL ABMU
+1 QUIT
+2 ;
PRTTXT2 KILL ABMU("FLG")
IF $LENGTH(ABMU("TXT"))<ABMU("LNG")
SET ABMU("F")=ABMU("TXT")
SET ABMU("TXT")=""
GOTO PRTTXT3
+1 SET ABMU("FLG")=""
FOR ABMU("C")=ABMU("LNG"):-1:1
SET ABMU("L")=$EXTRACT(ABMU("TXT"),ABMU("C"))
IF ABMU("L")=" "!(ABMU("L")="-")!(ABMU("L")="\")!(ABMU("L")=",")!(ABMU("L")="/")
QUIT
+2 SET ABMU("F")=$EXTRACT(ABMU("TXT"),1,ABMU("C")-1)
SET ABMU("TXT")=$EXTRACT(ABMU("TXT"),ABMU("C")+1,255)
+3 IF " "[ABMU("TXT")!(ABMU("TXT")="")!(ABMU("TXT")=" ")
KILL ABMU("FLG")
+4 ;
PRTTXT3 IF $DATA(ABMU("2TXT"))
DO 2
+1 WRITE ?ABMU("LM"),ABMU("F")
IF $DATA(ABMU("2TXT"))
WRITE ?ABMU("2LM"),ABMU("2F")
+2 IF ABMU("Q")=1
FOR ABMU("I")=1:1
IF '$DATA(ABMU(ABMU("I")))
QUIT
WRITE @$PIECE(ABMU(ABMU("I")),U),$PIECE(ABMU(ABMU("I")),U,2)
+3 IF $DATA(ABMU("FLG"))
WRITE !
SET ABMU("LM")=ABMU("LM")-ABMU("TAB")
SET ABMU("LNG")=ABMU("LNG")+ABMU("TAB")
SET ABMU("TAB")=0
+4 IF $DATA(ABMU("2TXT"))
SET ABMU("2LM")=ABMU("2LM")-ABMU("2TAB")
SET ABMU("2LNG")=ABMU("2LNG")+ABMU("2TAB")
SET ABMU("2TAB")=0
+5 QUIT
+6 ;
2 IF $DATA(ABMU("2TXT",ABMU("Q")))
SET ABMU("2F")=ABMU("2TXT",ABMU("Q"))
SET ABMU("FLG")=""
+1 IF '$TEST
KILL ABMU("2TXT")
+2 QUIT
+3 ;
HD DO PAZ^ABMDRUTL
IF $DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIROUT)
QUIT
HDB IF $DATA(IOF)
WRITE @IOF
SET ABM("PG")=ABM("PG")+1
+1 WRITE !!!,"Date: "
SET Y=DT
XECUTE ^DD("DD")
WRITE Y
+2 IF $DATA(ABM("S"))
SET ABM("NMM")="~~~~~~~~~~ "_ABM("S")_" LISTING (ALASKA) - "_ABM("NM")_" ~~~~~~~~~~"
+3 WRITE ?132-$LENGTH(ABM("NMM"))\2,ABM("NMM")
+4 WRITE ?122,"Page: ",ABM("PG")
+5 IF ABM("CAT")=2
WRITE !,"CPT",?70,"ICD CORRESPONDING",?114,"FEE",?121,"ANESTHESIA",!,"CODE - CPT DESCRIPTION",?70,"CODE - ICD DESCRIPTION",?113,"AMOUNT",?125,"FEE"
+6 IF '$TEST
WRITE !,"CPT",?70,"ICD CORRESPONDING",?126,"FEE",!,"CODE - CPT DESCRIPTION",?70,"CODE - ICD DESCRIPTION",?124,"AMOUNT"
+7 SET ABM("H")=""
SET $PIECE(ABM("H"),"=",132)=""
WRITE !,ABM("H")
+8 QUIT
