Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: ACHSCPTD

ACHSCPTD.m

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