ACHSCPTA ; IHS/ITSC/PMF - QUEUE CHS CPT CODE REPORT-SUMMARY ONLY ; [ 10/16/2001 8:16 AM ]
;;3.1;CONTRACT HEALTH MGMT SYSTEM;;JUN 11, 2001
;
K ^TMP("ACHSCPT",$J)
S ACHSUSR=$$USR^ACHS,ACHSFAC=DUZ(2)
W !!!?15,"***** CPT Code Summary for ",$P($G(^DIC(4,ACHSFAC,0)),U)," *****",!
CPTCODE ;
K ACHSCODE
S Y=$$DIR^XBDIR("Y","Summary for ALL CPT CODES","YES","","","",1)
I $D(DUOUT)!($D(DIROUT))!($D(DTOUT)) D END Q
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
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("^ACHSCPTB"),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,CPTCODE:Y=1
I '$D(IO("Q")) W:'$D(IO("S")) ! D:'$D(IO("S")) WAIT^DICD G ^ACHSCPTB
ZTLOAD ;Loads Taskman
S ZTRTN="^ACHSCPTB",ZTIO="",ZTDESC="CPT SUMMARY REPORT",ACHSQIO=ION_";"_IOST_";"_IOM_";"_IOSL
F %="ACHSFAC","ACHSUSR","ACHSQIO","ACHSCODE(","ACHSBEG","ACHSEND" S ZTSAVE(%)=""
D ^%ZTLOAD
K IO("Q"),ZTSK
D HOME^%ZIS
END ;
K DIR,DIROUT,DTOUT,DUOUT,Y,C,I
D EN^XBVK("ACHS"),^ACHSVAR,HOME^%ZIS
Q
;
ACHSCPTA ; IHS/ITSC/PMF - QUEUE CHS CPT CODE REPORT-SUMMARY ONLY ; [ 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
SET ACHSFAC=DUZ(2)
+5 WRITE !!!?15,"***** CPT Code Summary for ",$PIECE($GET(^DIC(4,ACHSFAC,0)),U)," *****",!
CPTCODE ;
+1 KILL ACHSCODE
+2 SET Y=$$DIR^XBDIR("Y","Summary for ALL CPT CODES","YES","","","",1)
+3 IF $DATA(DUOUT)!($DATA(DIROUT))!($DATA(DTOUT))
DO END
QUIT
+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
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("^ACHSCPTB")
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 CPTCODE
+9 IF '$DATA(IO("Q"))
IF '$DATA(IO("S"))
WRITE !
IF '$DATA(IO("S"))
DO WAIT^DICD
GOTO ^ACHSCPTB
ZTLOAD ;Loads Taskman
+1 SET ZTRTN="^ACHSCPTB"
SET ZTIO=""
SET ZTDESC="CPT SUMMARY REPORT"
SET ACHSQIO=ION_";"_IOST_";"_IOM_";"_IOSL
+2 FOR %="ACHSFAC","ACHSUSR","ACHSQIO","ACHSCODE(","ACHSBEG","ACHSEND"
SET ZTSAVE(%)=""
+3 DO ^%ZTLOAD
+4 KILL IO("Q"),ZTSK
+5 DO HOME^%ZIS
END ;
+1 KILL DIR,DIROUT,DTOUT,DUOUT,Y,C,I
+2 DO EN^XBVK("ACHS")
DO ^ACHSVAR
DO HOME^%ZIS
+3 QUIT
+4 ;
