- ABMDRFE2 ; IHS/ASDST/DMJ - CPT Management Reports ;
- ;;2.6;IHS 3P BILLING SYSTEM;;NOV 12, 2009
- ;
- ; IHS/SD/SDR - v2.6 CSV
- ;
- K DIR,ABMU S ABMM("SUB")="CPT-ICD-FEE LISTING" D ^ABMDBAN
- LOW S DIC="^ICPT(",DIC(0)="QEAM",DIC("A")="Select Low CPT CODE: " D ^DIC
- G XIT:$D(DTOUT)!$D(DUOUT)!(X=""),LOW:+Y<1 S ABM(1)=(+Y-1)
- HIGH S DIC="^ICPT(",DIC(0)="QEAM",DIC("A")="Select High CPT CODE: " D ^DIC
- G XIT:$D(DTOUT)!$D(DUOUT)!(X=""),HIGH:+Y<1 S ABM(2)=+Y
- W1 W !!! S %ZIS="Q",%ZIS("B")="",%ZIS("A")="Output DEVICE: " D ^%ZIS G:'$D(IO)!$G(POP) XIT
- S ABM("IOP")=ION G:$D(IO("Q")) QUE
- I IO'=IO(0),$E(IOST)'="C",'$D(IO("S")),$P($G(^ABMDPARM(1,0)),U,13)="Y" W !!,"As specified in the 3P Site Parameters File FORCED QUEUEING is in effect!",! G QUE
- PRQUE ;EP - Entry Point for Taskman
- U IO
- D HD
- S ABM=ABM(1) F S ABM=$O(^ICPT(ABM)) Q:'ABM!(ABM>ABM(2)) D
- .Q:$P($$CPT^ABMCVAPI(ABM,""),U,7)=1 ;CSV-c
- .I $Y>(IOSL-7) D HD
- .I $D(^ABMDFEE(11,11,ABM,0)) S ABMU(1)="?122"_U_$J($FN($P(^(0),U,2),",",2),9)
- .E I $D(^ABMDFEE(1,15,ABM,0)) S ABMU(1)="?122"_U_$J($FN($P(^(0),U,2),",",2),9)
- .E I $D(^ABMDFEE(1,17,ABM,0)) S ABMU(1)="?122"_U_$J($FN($P(^(0),U,2),",",2),9)
- .E I $D(^ABMDFEE(1,19,ABM,0)) S ABMU(1)="?122"_U_$J($FN($P(^(0),U,2),",",2),9)
- .E I $D(^ABMDFEE(1,23,ABM,0)) S ABMU(1)="?122"_U_$J($FN($P(^(0),U,2),",",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,42)
- .;end CSV-c
- .I $D(ABMU("2TXT",1)) S ABMU("2TXT")=ABMU("2TXT",1),ABMU("2LM")=70,ABMU("2RM")=120,ABMU("2TAB")=-6
- .S ABMU("LM")=0,ABMU("RM")=65,ABMU("TAB")=-10
- .D PRTTXT
- ;
- XIT K ABM
- I '$D(DTOUT)!'$D(DTOUT)!'$D(DIROUT),$E(IOST)="C",'$D(IO("S")) W ! S DIR(0)="FO",DIR("A")="(REPORT COMPLETE)" D ^DIR I 1
- D ^%ZISC
- 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 W @IOF
- W "CPT",?70,"ICD CORRESPONDING",?126,"FEE"
- W !,"CODE - CPT DESCRIPTION",?70,"CODE - ICD DESCRIPTION",?124,"AMOUNT"
- S ABM("H")="",$P(ABM("H"),"=",132)="" W !,ABM("H")
- Q
- ;
- QUE K IO("Q") S ZTRTN="PRQUE^ABMDRFEE",ZTDESC="CPT REPORT" F ABM="DUZ(2)","DUZ(0)","ABM(" S ZTSAVE(ABM)=""
- D ^%ZTLOAD W:$D(ZTSK) !,"REQUEST QUEUED!",!
- G XIT
- ABMDRFE2 ; IHS/ASDST/DMJ - CPT Management Reports ;
- +1 ;;2.6;IHS 3P BILLING SYSTEM;;NOV 12, 2009
- +2 ;
- +3 ; IHS/SD/SDR - v2.6 CSV
- +4 ;
- +5 KILL DIR,ABMU
- SET ABMM("SUB")="CPT-ICD-FEE LISTING"
- DO ^ABMDBAN
- LOW SET DIC="^ICPT("
- SET DIC(0)="QEAM"
- SET DIC("A")="Select Low CPT CODE: "
- DO ^DIC
- +1 IF $DATA(DTOUT)!$DATA(DUOUT)!(X="")
- GOTO XIT
- IF +Y<1
- GOTO LOW
- SET ABM(1)=(+Y-1)
- HIGH SET DIC="^ICPT("
- SET DIC(0)="QEAM"
- SET DIC("A")="Select High CPT CODE: "
- DO ^DIC
- +1 IF $DATA(DTOUT)!$DATA(DUOUT)!(X="")
- GOTO XIT
- IF +Y<1
- GOTO HIGH
- SET ABM(2)=+Y
- W1 WRITE !!!
- SET %ZIS="Q"
- SET %ZIS("B")=""
- SET %ZIS("A")="Output DEVICE: "
- DO ^%ZIS
- IF '$DATA(IO)!$GET(POP)
- GOTO XIT
- +1 SET ABM("IOP")=ION
- IF $DATA(IO("Q"))
- GOTO QUE
- +2 IF IO'=IO(0)
- IF $EXTRACT(IOST)'="C"
- IF '$DATA(IO("S"))
- IF $PIECE($GET(^ABMDPARM(1,0)),U,13)="Y"
- WRITE !!,"As specified in the 3P Site Parameters File FORCED QUEUEING is in effect!",!
- GOTO QUE
- PRQUE ;EP - Entry Point for Taskman
- +1 USE IO
- +2 DO HD
- +3 SET ABM=ABM(1)
- FOR
- SET ABM=$ORDER(^ICPT(ABM))
- IF 'ABM!(ABM>ABM(2))
- QUIT
- Begin DoDot:1
- +4 ;CSV-c
- IF $PIECE($$CPT^ABMCVAPI(ABM,""),U,7)=1
- QUIT
- +5 IF $Y>(IOSL-7)
- DO HD
- +6 IF $DATA(^ABMDFEE(11,11,ABM,0))
- SET ABMU(1)="?122"_U_$JUSTIFY($FNUMBER($PIECE(^(0),U,2),",",2),9)
- +7 IF '$TEST
- IF $DATA(^ABMDFEE(1,15,ABM,0))
- SET ABMU(1)="?122"_U_$JUSTIFY($FNUMBER($PIECE(^(0),U,2),",",2),9)
- +8 IF '$TEST
- IF $DATA(^ABMDFEE(1,17,ABM,0))
- SET ABMU(1)="?122"_U_$JUSTIFY($FNUMBER($PIECE(^(0),U,2),",",2),9)
- +9 IF '$TEST
- IF $DATA(^ABMDFEE(1,19,ABM,0))
- SET ABMU(1)="?122"_U_$JUSTIFY($FNUMBER($PIECE(^(0),U,2),",",2),9)
- +10 IF '$TEST
- IF $DATA(^ABMDFEE(1,23,ABM,0))
- SET ABMU(1)="?122"_U_$JUSTIFY($FNUMBER($PIECE(^(0),U,2),",",2),9)
- +11 ;start CSV-c
- +12 SET ABMU("TXT")=""
- +13 DO IHSCPTD^ABMCVAPI($PIECE(ABM("X0"),U),ABMZCPTD,"","")
- +14 SET ABMU("CP")=0
- +15 FOR
- SET ABMU("CP")=$ORDER(ABMZCPTD(ABMU("CP")))
- IF '$DATA(ABMZCPTD(ABMU("CP")))
- QUIT
- Begin DoDot:2
- +16 SET ABMU("TXT")=ABMU("TXT")_ABMZCPTD(ABMU("CP"))_" "
- End DoDot:2
- +17 ;end CSV-c
- +18 SET ABMU("TXT")=ABM_" - "_ABMU("TXT")
- +19 ;start CSV-c
- +20 SET ABM(3)=0
- +21 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,42)
- +22 ;end CSV-c
- +23 IF $DATA(ABMU("2TXT",1))
- SET ABMU("2TXT")=ABMU("2TXT",1)
- SET ABMU("2LM")=70
- SET ABMU("2RM")=120
- SET ABMU("2TAB")=-6
- +24 SET ABMU("LM")=0
- SET ABMU("RM")=65
- SET ABMU("TAB")=-10
- +25 DO PRTTXT
- End DoDot:1
- +26 ;
- XIT KILL ABM
- +1 IF '$DATA(DTOUT)!'$DATA(DTOUT)!'$DATA(DIROUT)
- IF $EXTRACT(IOST)="C"
- IF '$DATA(IO("S"))
- WRITE !
- SET DIR(0)="FO"
- SET DIR("A")="(REPORT COMPLETE)"
- DO ^DIR
- IF 1
- +2 DO ^%ZISC
- +3 QUIT
- +4 ;
- 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 WRITE @IOF
- +1 WRITE "CPT",?70,"ICD CORRESPONDING",?126,"FEE"
- +2 WRITE !,"CODE - CPT DESCRIPTION",?70,"CODE - ICD DESCRIPTION",?124,"AMOUNT"
- +3 SET ABM("H")=""
- SET $PIECE(ABM("H"),"=",132)=""
- WRITE !,ABM("H")
- +4 QUIT
- +5 ;
- QUE KILL IO("Q")
- SET ZTRTN="PRQUE^ABMDRFEE"
- SET ZTDESC="CPT REPORT"
- FOR ABM="DUZ(2)","DUZ(0)","ABM("
- SET ZTSAVE(ABM)=""
- +1 DO ^%ZTLOAD
- IF $DATA(ZTSK)
- WRITE !,"REQUEST QUEUED!",!
- +2 GOTO XIT
