- 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
