77 lines
2.3 KiB
Mathematica
77 lines
2.3 KiB
Mathematica
LRCAPPH4 ;DALOI/RSH/FHS-PRINT CPT CODES ;1-OCT-1998
|
|
;;5.2;LAB SERVICE;**263**;Sep 27,1994
|
|
EN ;
|
|
N LREND
|
|
S LREND=1
|
|
W @IOF,!!,$$CJ^XLFSTR("This option will print CPT CODE that have inactive",IOM)
|
|
W !,$$CJ^XLFSTR("date in the WKLD CODE(#64) ONLY",IOM)
|
|
W !!,$$CJ^XLFSTR("It DOES NOT provide a inactive CPT code list from",IOM)
|
|
W !,$$CJ^XLFSTR("the CPT (#81) file. ",IOM)
|
|
ASK ;
|
|
K DIR S DIR(0)="SO^1:Ready to print INACTIVE CPT CODES REPORT;2:Abort"
|
|
D ^DIR K DIR
|
|
I $S($G(DIRUT):1,$G(DUOUT):1,$G(DTOUT):1,Y=2:1,1:0) G END
|
|
K %ZIS S %ZIS="Q" D ^%ZIS
|
|
G END:POP
|
|
I $G(IO("Q")) D G END
|
|
. S ZTRTN="ACTIVE^LRCAPPH4",(LRION,ZTIO)=ION,ZTDESC="Print INVALID CPT CODE" D ^%ZTLOAD
|
|
. D ^%ZISC
|
|
. W:$D(ZTSK)'[0 !!?5," Tasked to Print on : ",LRION H 5
|
|
. K LRION
|
|
D ACTIVE
|
|
Q
|
|
ACTIVE ;Search ^LAM( and find INVALID CPT CODES
|
|
S LRACT=1,LREND=0
|
|
D EN^LRCAPPH3
|
|
W !
|
|
Q:$G(LREND)
|
|
D DQ("^TMP(""LRCAPPH"","_$J)
|
|
Q
|
|
DQ(LRNX) ;
|
|
; LRNODE= subscripted data storage array root
|
|
; ie ^TMP("LRCAPPH",$J OR X("LR"
|
|
; ^TMP("LRCAPPH",$J,0)="KERNEL DELETE DATE^REPORT DATE^REPORT NAME"
|
|
N LREND
|
|
S:$D(ZTQUEUED) ZTREQ="@" S LRPDT=$$FMTE^XLFDT($$NOW^XLFDT,"1P")
|
|
S (LRPAGE,LREND)=0,$P(LRLINE,"=",(IOM-1))=""
|
|
S LRNXL=$L(LRNX),LRNODE=LRNX
|
|
I $E(LRNODE,$L(LRNX))'="(",$E(LRNODE,$L(LRNX))'="," S LRNODE=LRNX_","
|
|
I $E(LRNODE,$L(LRNODE))'=")" S LRNODE=LRNODE_"0)"
|
|
Q:$S('$L($P(LRNODE,"(")):1,$E(LRNODE,$L(LRNODE))'=")":1,1:0)
|
|
S LRPTNM="Data listing of "_LRNODE
|
|
IO U IO
|
|
I $D(@LRNODE)#2 D
|
|
. S LRREC=$G(@LRNODE)
|
|
. S:$L($P(LRREC,U,3)) LRPTNM=$P(LRREC,U,3)
|
|
. S LRPDT=$P(LRREC,U,2)
|
|
. S:LRPDT LRPDT=$$FMTE^XLFDT(LRPDT,"1P")
|
|
. W !
|
|
. D HDR
|
|
F S LRNODE=$Q(@LRNODE) Q:$E(LRNODE,1,LRNXL)'=LRNX Q:$G(LREND) D
|
|
. Q:$G(LREND)
|
|
. W !,@LRNODE
|
|
. I $Y+4>IOSL D HDR Q:$G(LREND)
|
|
W:$D(ZTQUEUED) !,$$CJ^XLFSTR("End of Report",IOM),!
|
|
END ;
|
|
I '$D(ZTSK) W:'$G(LREND) !,$$CJ^XLFSTR("End of Report",IOM),!
|
|
I $E(IOST,1,2)="P-" W @IOF
|
|
D ^%ZISC
|
|
D END^LRCAPPH3
|
|
Q:$G(LRDBUG)
|
|
K DIR,DIRUT,DUOUT,LRLINE,LRNODE,LRNXL,LRPAGE,LRREC,LRX
|
|
K LRPDT,LRPTNM,LRT,POP,ZTIO,ZTDESC,ZTRTN,ZTSAVE
|
|
S LREND=0
|
|
Q
|
|
HDR ;
|
|
Q:$G(LREND)
|
|
I LRPAGE,$E(IOST,1,2)="C-" D Q:$G(LREND)
|
|
. N DIR
|
|
. S DIR(0)="E" D ^DIR
|
|
. S LREND=$G(DIRUT)
|
|
. Q:$G(LREND) W @IOF,!!
|
|
S LRPAGE=$G(LRPAGE)+1 I $G(LRPAGE)>1 W @IOF
|
|
CNTR W $$CJ^XLFSTR(LRPTNM,IOM),!
|
|
W $$CJ^XLFSTR(LRPDT_" Page: "_LRPAGE,IOM)
|
|
W !,LRLINE,!!
|
|
Q
|