| 1 | ECXUCPT ;ALB/TJL-CPT INQUIRY FOR MYSTERY FEEDER KEYS ; 10/15/03 2:12pm
|
|---|
| 2 | ;;3.0;DSS EXTRACTS;**49**;July 1, 2003
|
|---|
| 3 | ;
|
|---|
| 4 | EN ; entry point
|
|---|
| 5 | N X,Y,DATE,ECRUN,QFLG
|
|---|
| 6 | S QFLG=0
|
|---|
| 7 | ; get today's date
|
|---|
| 8 | D NOW^%DTC S DATE=X,Y=$E(%,1,12) D DD^%DT S ECRUN=$P(Y,"@") K %DT
|
|---|
| 9 | D BEGIN
|
|---|
| 10 | F D SELECT W @IOF Q:QFLG
|
|---|
| 11 | Q
|
|---|
| 12 | ;
|
|---|
| 13 | BEGIN ; display report description
|
|---|
| 14 | W @IOF
|
|---|
| 15 | W !,"This inquiry allows the user to select a CPT code, then displays"
|
|---|
| 16 | W !,"the Short Name, Category, and Description for the selected code."
|
|---|
| 17 | W !!
|
|---|
| 18 | Q
|
|---|
| 19 | ;
|
|---|
| 20 | SELECT ; user inputs for CPT Code
|
|---|
| 21 | N OUT,DIC,X,Y,DIR,ECXARR,ECXERR,ECXIEN
|
|---|
| 22 | S DIC="^ICPT(",DIC(0)="AZEMQ" D ^DIC
|
|---|
| 23 | I Y<0 S QFLG=1 Q
|
|---|
| 24 | S ECXIEN=+Y
|
|---|
| 25 | D GETS^DIQ(81,ECXIEN,".01;2;3;50*","E","ECXARR","ECXERR")
|
|---|
| 26 | I $D(ECXERR) W !,"CPT Code Error." S QFLG=1 Q
|
|---|
| 27 | D PRINT
|
|---|
| 28 | S DIR(0)="E" W ! D ^DIR K DIR I 'Y S QFLG=1
|
|---|
| 29 | Q
|
|---|
| 30 | ;
|
|---|
| 31 | PRINT ; display results of inquiry
|
|---|
| 32 | N LN,DA,DESCDA
|
|---|
| 33 | S $P(LN,"-",80)=""
|
|---|
| 34 | W !!,"CPT Inquiry",?54,"Date: ",ECRUN,!,LN,!
|
|---|
| 35 | S DA=ECXIEN S DA=DA_","
|
|---|
| 36 | W !,"CPT Code: ",ECXARR(81,DA,.01,"E")
|
|---|
| 37 | W ?30,"Short Name: ",ECXARR(81,DA,2,"E")
|
|---|
| 38 | W !!,"Category: ",ECXARR(81,DA,3,"E")
|
|---|
| 39 | W !!,"Description: "
|
|---|
| 40 | F LN=1:1 S DESCDA=LN_","_DA Q:'$D(ECXARR(81.01,DESCDA,.01,"E")) D
|
|---|
| 41 | .W ECXARR(81.01,DESCDA,.01,"E"),!
|
|---|
| 42 | W !!!
|
|---|
| 43 | Q
|
|---|
| 44 | ;
|
|---|
