| 1 | LRCAPPH4 ;DALOI/RSH/FHS-PRINT CPT CODES ;1-OCT-1998
|
|---|
| 2 | ;;5.2;LAB SERVICE;**263**;Sep 27,1994
|
|---|
| 3 | EN ;
|
|---|
| 4 | N LREND
|
|---|
| 5 | S LREND=1
|
|---|
| 6 | W @IOF,!!,$$CJ^XLFSTR("This option will print CPT CODE that have inactive",IOM)
|
|---|
| 7 | W !,$$CJ^XLFSTR("date in the WKLD CODE(#64) ONLY",IOM)
|
|---|
| 8 | W !!,$$CJ^XLFSTR("It DOES NOT provide a inactive CPT code list from",IOM)
|
|---|
| 9 | W !,$$CJ^XLFSTR("the CPT (#81) file. ",IOM)
|
|---|
| 10 | ASK ;
|
|---|
| 11 | K DIR S DIR(0)="SO^1:Ready to print INACTIVE CPT CODES REPORT;2:Abort"
|
|---|
| 12 | D ^DIR K DIR
|
|---|
| 13 | I $S($G(DIRUT):1,$G(DUOUT):1,$G(DTOUT):1,Y=2:1,1:0) G END
|
|---|
| 14 | K %ZIS S %ZIS="Q" D ^%ZIS
|
|---|
| 15 | G END:POP
|
|---|
| 16 | I $G(IO("Q")) D G END
|
|---|
| 17 | . S ZTRTN="ACTIVE^LRCAPPH4",(LRION,ZTIO)=ION,ZTDESC="Print INVALID CPT CODE" D ^%ZTLOAD
|
|---|
| 18 | . D ^%ZISC
|
|---|
| 19 | . W:$D(ZTSK)'[0 !!?5," Tasked to Print on : ",LRION H 5
|
|---|
| 20 | . K LRION
|
|---|
| 21 | D ACTIVE
|
|---|
| 22 | Q
|
|---|
| 23 | ACTIVE ;Search ^LAM( and find INVALID CPT CODES
|
|---|
| 24 | S LRACT=1,LREND=0
|
|---|
| 25 | D EN^LRCAPPH3
|
|---|
| 26 | W !
|
|---|
| 27 | Q:$G(LREND)
|
|---|
| 28 | D DQ("^TMP(""LRCAPPH"","_$J)
|
|---|
| 29 | Q
|
|---|
| 30 | DQ(LRNX) ;
|
|---|
| 31 | ; LRNODE= subscripted data storage array root
|
|---|
| 32 | ; ie ^TMP("LRCAPPH",$J OR X("LR"
|
|---|
| 33 | ; ^TMP("LRCAPPH",$J,0)="KERNEL DELETE DATE^REPORT DATE^REPORT NAME"
|
|---|
| 34 | N LREND
|
|---|
| 35 | S:$D(ZTQUEUED) ZTREQ="@" S LRPDT=$$FMTE^XLFDT($$NOW^XLFDT,"1P")
|
|---|
| 36 | S (LRPAGE,LREND)=0,$P(LRLINE,"=",(IOM-1))=""
|
|---|
| 37 | S LRNXL=$L(LRNX),LRNODE=LRNX
|
|---|
| 38 | I $E(LRNODE,$L(LRNX))'="(",$E(LRNODE,$L(LRNX))'="," S LRNODE=LRNX_","
|
|---|
| 39 | I $E(LRNODE,$L(LRNODE))'=")" S LRNODE=LRNODE_"0)"
|
|---|
| 40 | Q:$S('$L($P(LRNODE,"(")):1,$E(LRNODE,$L(LRNODE))'=")":1,1:0)
|
|---|
| 41 | S LRPTNM="Data listing of "_LRNODE
|
|---|
| 42 | IO U IO
|
|---|
| 43 | I $D(@LRNODE)#2 D
|
|---|
| 44 | . S LRREC=$G(@LRNODE)
|
|---|
| 45 | . S:$L($P(LRREC,U,3)) LRPTNM=$P(LRREC,U,3)
|
|---|
| 46 | . S LRPDT=$P(LRREC,U,2)
|
|---|
| 47 | . S:LRPDT LRPDT=$$FMTE^XLFDT(LRPDT,"1P")
|
|---|
| 48 | . W !
|
|---|
| 49 | . D HDR
|
|---|
| 50 | F S LRNODE=$Q(@LRNODE) Q:$E(LRNODE,1,LRNXL)'=LRNX Q:$G(LREND) D
|
|---|
| 51 | . Q:$G(LREND)
|
|---|
| 52 | . W !,@LRNODE
|
|---|
| 53 | . I $Y+4>IOSL D HDR Q:$G(LREND)
|
|---|
| 54 | W:$D(ZTQUEUED) !,$$CJ^XLFSTR("End of Report",IOM),!
|
|---|
| 55 | END ;
|
|---|
| 56 | I '$D(ZTSK) W:'$G(LREND) !,$$CJ^XLFSTR("End of Report",IOM),!
|
|---|
| 57 | I $E(IOST,1,2)="P-" W @IOF
|
|---|
| 58 | D ^%ZISC
|
|---|
| 59 | D END^LRCAPPH3
|
|---|
| 60 | Q:$G(LRDBUG)
|
|---|
| 61 | K DIR,DIRUT,DUOUT,LRLINE,LRNODE,LRNXL,LRPAGE,LRREC,LRX
|
|---|
| 62 | K LRPDT,LRPTNM,LRT,POP,ZTIO,ZTDESC,ZTRTN,ZTSAVE
|
|---|
| 63 | S LREND=0
|
|---|
| 64 | Q
|
|---|
| 65 | HDR ;
|
|---|
| 66 | Q:$G(LREND)
|
|---|
| 67 | I LRPAGE,$E(IOST,1,2)="C-" D Q:$G(LREND)
|
|---|
| 68 | . N DIR
|
|---|
| 69 | . S DIR(0)="E" D ^DIR
|
|---|
| 70 | . S LREND=$G(DIRUT)
|
|---|
| 71 | . Q:$G(LREND) W @IOF,!!
|
|---|
| 72 | S LRPAGE=$G(LRPAGE)+1 I $G(LRPAGE)>1 W @IOF
|
|---|
| 73 | CNTR W $$CJ^XLFSTR(LRPTNM,IOM),!
|
|---|
| 74 | W $$CJ^XLFSTR(LRPDT_" Page: "_LRPAGE,IOM)
|
|---|
| 75 | W !,LRLINE,!!
|
|---|
| 76 | Q
|
|---|
