ACHSCPTD ; IHS/ITSC/PMF - QUEUE CHS CPT CODE REPORT-BY VENDOR ; [ 10/16/2001 8:16 AM ]
;;3.1;CONTRACT HEALTH MGMT SYSTEM;;JUN 11, 2001
;
K ^TMP("ACHSCPT",$J)
S ACHSUSR=$$USR^ACHS
W !!!!,$$C^XBFUNC("***** CPT Code Summary for "_$$LOC^ACHS_" *****",80)
S ACHSFAC=DUZ(2)
VENDOR ;
K ACHSVNDR
S Y=$$DIR^XBDIR("Y","CPT Code Report for ALL VENDORS","YES","","","",1)
G END:$D(DUOUT)!$D(DTOUT)!$D(DIROUT)
I Y=1 S ACHSVNDR(0)="ALL" G CPTCODE
SELVNDR ;
S ACHSVEN=+$$DIR^XBDIR("P^AUTTVNDR(:EMQZ","Enter VENDOR","","","","",1)
G VENDOR:$D(DUOUT),END:$D(DIROUT)!$D(DTOUT)
CPTCODE ;
K ACHSCODE
S Y=$$DIR^XBDIR("Y","Summary for ALL CPT CODES","YES","","","",1)
G VENDOR:$D(DUOUT),END:$D(DIROUT)!$D(DTOUT)
I Y=1 S ACHSCODE(0)="ALL" G DOS
HELP ;
W *7,*7,!!?8,$$REPEAT^XLFSTR("*",20)
W " SELECTING CPT CODES ",$$REPEAT^XLFSTR("*",20)
W !!?8,"1. You may enter '??' at any time for a list of valid codes."
W !?8,"2. You may enter CPT CODES by NAME or NUMBER."
W !?8,"3. You may enter from 1 to 10 CPT CODES."
W !?8,"4. Press <RETURN> to terminate the selection process."
W !?8,"5. Enter '^^' at any prompt to EXIT THIS PROGRAM."
W *7,*7,!!?8,$$REPEAT^XLFSTR("*",61)
W !!
S ACHS=0
K DIR
ENTCODE ;
S DIR(0)="PO^ICPT(:EMZQ",DIR("A")="Enter CPT CODE"
D ^DIR
G DOS:$D(DIRUT)&$D(ACHSCODE),CPTCODE:$D(DUOUT),END:$D(DTOUT)!$D(DIROUT)
I ACHS=10 W *7,*7,!!?15,"That's 10!" G DOS
S ACHS=ACHS+1
S:+Y>0 ACHSCODE(+Y)=""
I '$D(ACHSCODE),+Y'>0 W *7,!!?22,"At least one entry is required.",!?10,"Please select a CPT CODE or enter '^^' to exit this program.",! K ACHSCODE
G ENTCODE
;
DOS ;Select Dates of Service
SELBEG ;
S ACHSBEG=$$DIR^XBDIR("D^:NOW:EX","Enter the BEGINNING DATE OF SERVICE","","","","",1)
G CPTCODE:$D(DUOUT),END:$D(DIROUT)!$D(DTOUT)
SELEND ;
S ACHSEND=$$DIR^XBDIR("D^:NOW:EX","Enter the ENDING DATE OF SERVICE",$$FMTE^XLFDT(DT),"","","",1)
G SELBEG:$D(DUOUT),END:$D(DIROUT)!$D(DTOUT)
G:$$EBB^ACHS(ACHSBEG,ACHSEND) SELEND
REPTYP ;
K DIR
S DIR(0)="S^S:SUMMARY;D:DETAILED",DIR("B")="Summary",DIR("A")=" Report Type "
S DIR("?",1)="Enter 'S' or <RETURN> for a 'SUMMARY' report which includes"
S DIR("?",2)="VENDOR NAME, CPT CODE, TOTALS, and PERCENTAGES ONLY."
S DIR("?",3)="Enter 'D' for a 'DETAILED' report which also includes"
S DIR("?")="DATES of SERVICE and WORKLOAD DATA."
D ^DIR
G SELBEG:$D(DUOUT),END:$D(DTOUT),END:$D(DIROUT)
S ACHSRTYP=Y
DEVICE ;Device Selection
W *7,!!?20,"This report may take awhile to compile.",!?15," It is recommended that you QUEUE to a PRINTER.",!
K DIR
S %=$$PB^ACHS
I %=U!$D(DTOUT)!$D(DUOUT) D END Q
I %="B" D VIEWR^XBLM($S(ACHSRTYP="S":"^ACHSCPTE",1:"^ACHSCPTG")),EN^XBVK("VALM"),END Q
S %ZIS="PQ"
D ^%ZIS
I POP W !,"NO DEVICE SELECTED - REQUEST ABORTED" S DIR(0)="E" D ^DIR D HOME^%ZIS G END:Y=0,VENDOR:Y=1
I '$D(IO("Q")) W:'$D(IO("S")) ! D:'$D(IO("S")) WAIT^DICD G ^ACHSCPTE:ACHSRTYP="S",^ACHSCPTG
I $D(IO("S"))!($E(IOST)'="P") G DEVICE
ZTLOAD ;Loads Taskman
S ZTRTN=$S(ACHSRTYP="S":"^ACHSCPTE",ACHSRTYP="D":"^ACHSCPTG"),ZTIO="",ZTDESC="COMPILE CPT SUMMARY REPORT",ACHSQIO=ION_";"_IOST_";"_IOM_";"_IOSL
F %="ACHSFAC","ACHSVNDR(","ACHSVEN","ACHSUSR","ACHSQIO","ACHSSER","ACHSRTYP","ACHSCODE(","ACHSBEG","ACHSEND" S ZTSAVE(%)=""
D ^%ZTLOAD
K IO("Q"),ZTSK
D HOME^%ZIS
END ;
K I,C,DIR,DIROUT,DIRUT,DTOUT,DUOUT
D EN^XBVK("ACHS"),^ACHSVAR,HOME^%ZIS
Q
;
ACHSCPTD ; IHS/ITSC/PMF - QUEUE CHS CPT CODE REPORT-BY VENDOR ; [ 10/16/2001 8:16 AM ]
+1 ;;3.1;CONTRACT HEALTH MGMT SYSTEM;;JUN 11, 2001
+2 ;
+3 KILL ^TMP("ACHSCPT",$JOB)
+4 SET ACHSUSR=$$USR^ACHS
+5 WRITE !!!!,$$C^XBFUNC("***** CPT Code Summary for "_$$LOC^ACHS_" *****",80)
+6 SET ACHSFAC=DUZ(2)
VENDOR ;
+1 KILL ACHSVNDR
+2 SET Y=$$DIR^XBDIR("Y","CPT Code Report for ALL VENDORS","YES","","","",1)
+3 IF $DATA(DUOUT)!$DATA(DTOUT)!$DATA(DIROUT)
GOTO END
+4 IF Y=1
SET ACHSVNDR(0)="ALL"
GOTO CPTCODE
SELVNDR ;
+1 SET ACHSVEN=+$$DIR^XBDIR("P^AUTTVNDR(:EMQZ","Enter VENDOR","","","","",1)
+2 IF $DATA(DUOUT)
GOTO VENDOR
IF $DATA(DIROUT)!$DATA(DTOUT)
GOTO END
CPTCODE ;
+1 KILL ACHSCODE
+2 SET Y=$$DIR^XBDIR("Y","Summary for ALL CPT CODES","YES","","","",1)
+3 IF $DATA(DUOUT)
GOTO VENDOR
IF $DATA(DIROUT)!$DATA(DTOUT)
GOTO END
+4 IF Y=1
SET ACHSCODE(0)="ALL"
GOTO DOS
HELP ;
+1 WRITE *7,*7,!!?8,$$REPEAT^XLFSTR("*",20)
+2 WRITE " SELECTING CPT CODES ",$$REPEAT^XLFSTR("*",20)
+3 WRITE !!?8,"1. You may enter '??' at any time for a list of valid codes."
+4 WRITE !?8,"2. You may enter CPT CODES by NAME or NUMBER."
+5 WRITE !?8,"3. You may enter from 1 to 10 CPT CODES."
+6 WRITE !?8,"4. Press <RETURN> to terminate the selection process."
+7 WRITE !?8,"5. Enter '^^' at any prompt to EXIT THIS PROGRAM."
+8 WRITE *7,*7,!!?8,$$REPEAT^XLFSTR("*",61)
+9 WRITE !!
+10 SET ACHS=0
+11 KILL DIR
ENTCODE ;
+1 SET DIR(0)="PO^ICPT(:EMZQ"
SET DIR("A")="Enter CPT CODE"
+2 DO ^DIR
+3 IF $DATA(DIRUT)&$DATA(ACHSCODE)
GOTO DOS
IF $DATA(DUOUT)
GOTO CPTCODE
IF $DATA(DTOUT)!$DATA(DIROUT)
GOTO END
+4 IF ACHS=10
WRITE *7,*7,!!?15,"That's 10!"
GOTO DOS
+5 SET ACHS=ACHS+1
+6 IF +Y>0
SET ACHSCODE(+Y)=""
+7 IF '$DATA(ACHSCODE)
IF +Y'>0
WRITE *7,!!?22,"At least one entry is required.",!?10,"Please select a CPT CODE or enter '^^' to exit this program.",!
KILL ACHSCODE
+8 GOTO ENTCODE
+9 ;
DOS ;Select Dates of Service
SELBEG ;
+1 SET ACHSBEG=$$DIR^XBDIR("D^:NOW:EX","Enter the BEGINNING DATE OF SERVICE","","","","",1)
+2 IF $DATA(DUOUT)
GOTO CPTCODE
IF $DATA(DIROUT)!$DATA(DTOUT)
GOTO END
SELEND ;
+1 SET ACHSEND=$$DIR^XBDIR("D^:NOW:EX","Enter the ENDING DATE OF SERVICE",$$FMTE^XLFDT(DT),"","","",1)
+2 IF $DATA(DUOUT)
GOTO SELBEG
IF $DATA(DIROUT)!$DATA(DTOUT)
GOTO END
+3 IF $$EBB^ACHS(ACHSBEG,ACHSEND)
GOTO SELEND
REPTYP ;
+1 KILL DIR
+2 SET DIR(0)="S^S:SUMMARY;D:DETAILED"
SET DIR("B")="Summary"
SET DIR("A")=" Report Type "
+3 SET DIR("?",1)="Enter 'S' or <RETURN> for a 'SUMMARY' report which includes"
+4 SET DIR("?",2)="VENDOR NAME, CPT CODE, TOTALS, and PERCENTAGES ONLY."
+5 SET DIR("?",3)="Enter 'D' for a 'DETAILED' report which also includes"
+6 SET DIR("?")="DATES of SERVICE and WORKLOAD DATA."
+7 DO ^DIR
+8 IF $DATA(DUOUT)
GOTO SELBEG
IF $DATA(DTOUT)
GOTO END
IF $DATA(DIROUT)
GOTO END
+9 SET ACHSRTYP=Y
DEVICE ;Device Selection
+1 WRITE *7,!!?20,"This report may take awhile to compile.",!?15," It is recommended that you QUEUE to a PRINTER.",!
+2 KILL DIR
+3 SET %=$$PB^ACHS
+4 IF %=U!$DATA(DTOUT)!$DATA(DUOUT)
DO END
QUIT
+5 IF %="B"
DO VIEWR^XBLM($SELECT(ACHSRTYP="S":"^ACHSCPTE",1:"^ACHSCPTG"))
DO EN^XBVK("VALM")
DO END
QUIT
+6 SET %ZIS="PQ"
+7 DO ^%ZIS
+8 IF POP
WRITE !,"NO DEVICE SELECTED - REQUEST ABORTED"
SET DIR(0)="E"
DO ^DIR
DO HOME^%ZIS
IF Y=0
GOTO END
IF Y=1
GOTO VENDOR
+9 IF '$DATA(IO("Q"))
IF '$DATA(IO("S"))
WRITE !
IF '$DATA(IO("S"))
DO WAIT^DICD
IF ACHSRTYP="S"
GOTO ^ACHSCPTE
GOTO ^ACHSCPTG
+10 IF $DATA(IO("S"))!($EXTRACT(IOST)'="P")
GOTO DEVICE
ZTLOAD ;Loads Taskman
+1 SET ZTRTN=$SELECT(ACHSRTYP="S":"^ACHSCPTE",ACHSRTYP="D":"^ACHSCPTG")
SET ZTIO=""
SET ZTDESC="COMPILE CPT SUMMARY REPORT"
SET ACHSQIO=ION_";"_IOST_";"_IOM_";"_IOSL
+2 FOR %="ACHSFAC","ACHSVNDR(","ACHSVEN","ACHSUSR","ACHSQIO","ACHSSER","ACHSRTYP","ACHSCODE(","ACHSBEG","ACHSEND"
SET ZTSAVE(%)=""
+3 DO ^%ZTLOAD
+4 KILL IO("Q"),ZTSK
+5 DO HOME^%ZIS
END ;
+1 KILL I,C,DIR,DIROUT,DIRUT,DTOUT,DUOUT
+2 DO EN^XBVK("ACHS")
DO ^ACHSVAR
DO HOME^%ZIS
+3 QUIT
+4 ;
