ECINCPT ;ALB/JAM-Procedure Codes with Inactive CPTs Report ;Jan 04, 2021@17:52
;;2.0;EVENT CAPTURE;**72,119,152**;8 May 96;Build 19
; Routine to report National/Local Procedure Codes with Inactive CPT
; Codes Report
EN ;entry point
N ZTIO,ZTDESC,ZTRTN,ECPG,ECOUT
S ZTIO=ION
S ZTDESC="NATIONAL/LOCAL PROCEDURE CODES WITH INACTIVE CPT"
S ZTRTN="START^ECINCPT"
D EN^XUTMDEVQ(ZTRTN,ZTDESC,.ZTSAVE)
I POP Q
I IO'=IO(0) D ^%ZISC
D HOME^%ZIS
Q
START ; Routine execution
; Variables passed in -152
; ECPTYP - Where to send output (P)rinter, (D)evice or screen
; or (E)xport
; ECRN - Preferred Report (N-ational, L-ocal or Both)
; ECSM - Sort Method (P-rocedure Name, N-ational Number,C-PT Code,D-Inactive Date)
; ECSORT - Sort Order "A"scending, "D"escending
;
;
N ECI,EC0,ECPT,ECN,ECD,ECPI,ECDT,ECPG,ECOUT,ECRDT,CNT ;119
S (ECI,ECOUT)=0,ECPG=1,CNT=1 ;119
N ECPTDT,ECINDX,I,NM,IEN,DATA,ECSRTBY ;152
S %H=$H S ECRDT=$$HTE^XLFDT(%H,1)
;I $G(ECPTYP)="E" S ^TMP($J,"ECRPT",CNT)="NATIONAL NUMBER^NATIONAL NAME^CPT CODE^INACTIVE DATE" ;119,152 - Commented this line
;I $G(ECPTYP)'="E" D HEADER ;119,152 - Commented this line
S ECSRTBY(ECSM)=$S(ECSM="P":"ECD",ECSM="N":"ECN",ECSM="C":"ECPT",1:"ECPTDT") ;152
F S ECI=$O(^EC(725,ECI)) Q:'ECI D I ECOUT Q
.S EC0=$G(^EC(725,ECI,0)),ECPT=$P(EC0,"^",5)
.Q:EC0="" Q:ECPT=""
.S ECN=$P(EC0,"^",2),ECD=$P(EC0,"^"),ECPI=$$CPT^ICPTCOD(ECPT)
.Q:+ECPI<1 Q:$P(ECPI,"^",7)
.;152 - Begins
.I $G(ECRN)="N"&(ECI>89999) Q ; If looking for nation entries and entry has a local number, quit
.I $G(ECRN)="L"&(ECI<90000) Q ; If looking for local entries and entry has a national number, quit
.S ECDT=$TR($$FMTE^XLFDT($P(ECPI,"^",8),"2F")," ","0")
.S ECPTDT=$P(ECPI,U,8),ECPT=$P(ECPI,U,2)
.;I $G(ECPTYP)'="E" I ($Y+3)>IOSL D PAGE Q:ECOUT D HEADER ;119
.;I $G(ECPTYP)="E" S CNT=CNT+1,^TMP($J,"ECRPT",CNT)=ECN_U_ECD_U_$P(ECPI,U,2)_U_ECDT Q ;119
.;W !,ECN,?10,ECD,?60,$P(ECPI,"^",2),?68,ECDT
.S ^TMP($J,"ECRPT",@ECSRTBY(ECSM),ECN,ECD)=ECN_U_ECD_U_$P(ECPI,U,2)_U_ECDT
.;152 - Ends
D PRINT(ECSORT) ;152 - Added this line
;I $G(ECPTYP)'="E" I 'ECOUT D PAGE ;119,152 - Commented this line
Q
PRINT(PORD) ; 152 - Added this tag to print report according to the sort order
; PORD to Print: "A"scending or "D"escending
N I,I1,I2,LINE
S PORD=$S(PORD="A":1,1:-1)
I $G(ECPTYP)="E" D EXPORT(PORD) G END
S I=""
I $G(ECPTYP)'="E" D HEADER
F S I=$O(^TMP($J,"ECRPT",I),PORD) Q:I="" D
.S I1="" F S I1=$O(^TMP($J,"ECRPT",I,I1),PORD) Q:I1="" D
..S I2="" F S I2=$O(^TMP($J,"ECRPT",I,I1,I2),PORD) Q:I2="" D
...S LINE=^TMP($J,"ECRPT",I,I1,I2)
...W !,$P(LINE,U),?10,$P(LINE,U,2),?60,$P(LINE,U,3),?68,$P(LINE,U,4)
...I ($Y+4)>IOSL D HEADER ;D PAGE Q:ECOUT D HEADER ;152
.I ($Y+4)>IOSL D HEADER ;152
I $G(ECPTYP)'="E" I 'ECOUT D PAGE ;119
END D ^ECKILL Q:$D(ECGUI)!($G(ECPTYP)="E") W @IOF D ^%ZISC S:$D(ZTQUEUED) ZTREQ="@" ;152
Q
N I,SORT ;152
S SORT=$S(ECSM="P":"Procedure Name",ECSM="N":"Procedure Number",ECSM="C":"CPT Code",1:"CPT Inactive Date") ;152
W:$E(IOST,1,2)="C-"!(ECPG>1) @IOF
W $S(ECRN="N":"NATIONAL",ECRN="L":"LOCAL",1:"NATIONAL/LOCAL")_" PROCEDURE CODES WITH INACTIVE CPT CODES" ;152
W ?68,"Page: ",ECPG,!?(80-(10+$L(ECRDT))\2),"Run Date : ",ECRDT,! ;152 center the 2nd line
W ?(80-(9+$L(SORT))\2),"Sorted by ",SORT,! ;152
W "Procedure",?60,"CPT",?68,"Inactive",! ;152 Changed "National" to "Procedure"
W "Number",?10,"Procedure Name",?60,"Code",?68,"Date",! ;152 Change "National" to "Procedure"
S ECPG=ECPG+1
F I=1:1:80 W "-"
Q
PAGE ;
N SS,JJ
I $D(ECPG),$E(IOST,1,2)="C-" D
. S SS=22-$Y F JJ=1:1:SS W !
. S DIR(0)="E" W ! D ^DIR K DIR I 'Y S ECOUT=1
Q
EXPORT(PORD) ;152 - Created this tag for export format
;PORD: Print Order : Ascending or Descending.
N I,I1,I2,LINE
Q:'$D(^TMP($J,"ECRPT"))
M ^TMP("ECINCPT",$J)=^TMP($J,"ECRPT")
K ^TMP($J,"ECRPT")
S CNT=1,I=""
S ^TMP($J,"ECRPT",CNT)="PROCEDURE NUMBER^PROCEDURE NAME^CPT CODE^INACTIVE DATE"
F S I=$O(^TMP("ECINCPT",$J,I),PORD) Q:I="" D
.S I1="" F S I1=$O(^TMP("ECINCPT",$J,I,I1),PORD) Q:I1="" D
..S I2="" F S I2=$O(^TMP("ECINCPT",$J,I,I1,I2),PORD) Q:I2="" D
...S LINE=^TMP("ECINCPT",$J,I,I1,I2)
...S CNT=CNT+1
...S ^TMP($J,"ECRPT",CNT)=LINE
K ^TMP("ECINCPT",$J)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HECINCPT 4398 printed Apr 09, 2024@21:04:26 Page 2
ECINCPT ;ALB/JAM-Procedure Codes with Inactive CPTs Report ;Jan 04, 2021@17:52
+1 ;;2.0;EVENT CAPTURE;**72,119,152**;8 May 96;Build 19
+2 ; Routine to report National/Local Procedure Codes with Inactive CPT
+3 ; Codes Report
EN ;entry point
+1 NEW ZTIO,ZTDESC,ZTRTN,ECPG,ECOUT
+2 SET ZTIO=ION
+3 SET ZTDESC="NATIONAL/LOCAL PROCEDURE CODES WITH INACTIVE CPT"
+4 SET ZTRTN="START^ECINCPT"
+5 DO EN^XUTMDEVQ(ZTRTN,ZTDESC,.ZTSAVE)
+6 IF POP
QUIT
+7 IF IO'=IO(0)
DO ^%ZISC
+8 DO HOME^%ZIS
+9 QUIT
START ; Routine execution
+1 ; Variables passed in -152
+2 ; ECPTYP - Where to send output (P)rinter, (D)evice or screen
+3 ; or (E)xport
+4 ; ECRN - Preferred Report (N-ational, L-ocal or Both)
+5 ; ECSM - Sort Method (P-rocedure Name, N-ational Number,C-PT Code,D-Inactive Date)
+6 ; ECSORT - Sort Order "A"scending, "D"escending
+7 ;
+8 ;
+9 ;119
NEW ECI,EC0,ECPT,ECN,ECD,ECPI,ECDT,ECPG,ECOUT,ECRDT,CNT
+10 ;119
SET (ECI,ECOUT)=0
SET ECPG=1
SET CNT=1
+11 ;152
NEW ECPTDT,ECINDX,I,NM,IEN,DATA,ECSRTBY
+12 SET %H=$HOROLOG
SET ECRDT=$$HTE^XLFDT(%H,1)
+13 ;I $G(ECPTYP)="E" S ^TMP($J,"ECRPT",CNT)="NATIONAL NUMBER^NATIONAL NAME^CPT CODE^INACTIVE DATE" ;119,152 - Commented this line
+14 ;I $G(ECPTYP)'="E" D HEADER ;119,152 - Commented this line
+15 ;152
SET ECSRTBY(ECSM)=$SELECT(ECSM="P":"ECD",ECSM="N":"ECN",ECSM="C":"ECPT",1:"ECPTDT")
+16 FOR
SET ECI=$ORDER(^EC(725,ECI))
if 'ECI
QUIT
Begin DoDot:1
+17 SET EC0=$GET(^EC(725,ECI,0))
SET ECPT=$PIECE(EC0,"^",5)
+18 if EC0=""
QUIT
if ECPT=""
QUIT
+19 SET ECN=$PIECE(EC0,"^",2)
SET ECD=$PIECE(EC0,"^")
SET ECPI=$$CPT^ICPTCOD(ECPT)
+20 if +ECPI<1
QUIT
if $PIECE(ECPI,"^",7)
QUIT
+21 ;152 - Begins
+22 ; If looking for nation entries and entry has a local number, quit
IF $GET(ECRN)="N"&(ECI>89999)
QUIT
+23 ; If looking for local entries and entry has a national number, quit
IF $GET(ECRN)="L"&(ECI<90000)
QUIT
+24 SET ECDT=$TRANSLATE($$FMTE^XLFDT($PIECE(ECPI,"^",8),"2F")," ","0")
+25 SET ECPTDT=$PIECE(ECPI,U,8)
SET ECPT=$PIECE(ECPI,U,2)
+26 ;I $G(ECPTYP)'="E" I ($Y+3)>IOSL D PAGE Q:ECOUT D HEADER ;119
+27 ;I $G(ECPTYP)="E" S CNT=CNT+1,^TMP($J,"ECRPT",CNT)=ECN_U_ECD_U_$P(ECPI,U,2)_U_ECDT Q ;119
+28 ;W !,ECN,?10,ECD,?60,$P(ECPI,"^",2),?68,ECDT
+29 SET ^TMP($JOB,"ECRPT",@ECSRTBY(ECSM),ECN,ECD)=ECN_U_ECD_U_$PIECE(ECPI,U,2)_U_ECDT
+30 ;152 - Ends
End DoDot:1
IF ECOUT
QUIT
+31 ;152 - Added this line
DO PRINT(ECSORT)
+32 ;I $G(ECPTYP)'="E" I 'ECOUT D PAGE ;119,152 - Commented this line
+33 QUIT
PRINT(PORD) ; 152 - Added this tag to print report according to the sort order
+1 ; PORD to Print: "A"scending or "D"escending
+2 NEW I,I1,I2,LINE
+3 SET PORD=$SELECT(PORD="A":1,1:-1)
+4 IF $GET(ECPTYP)="E"
DO EXPORT(PORD)
GOTO END
+5 SET I=""
+6 IF $GET(ECPTYP)'="E"
DO HEADER
+7 FOR
SET I=$ORDER(^TMP($JOB,"ECRPT",I),PORD)
if I=""
QUIT
Begin DoDot:1
+8 SET I1=""
FOR
SET I1=$ORDER(^TMP($JOB,"ECRPT",I,I1),PORD)
if I1=""
QUIT
Begin DoDot:2
+9 SET I2=""
FOR
SET I2=$ORDER(^TMP($JOB,"ECRPT",I,I1,I2),PORD)
if I2=""
QUIT
Begin DoDot:3
+10 SET LINE=^TMP($JOB,"ECRPT",I,I1,I2)
+11 WRITE !,$PIECE(LINE,U),?10,$PIECE(LINE,U,2),?60,$PIECE(LINE,U,3),?68,$PIECE(LINE,U,4)
+12 ;D PAGE Q:ECOUT D HEADER ;152
IF ($Y+4)>IOSL
DO HEADER
End DoDot:3
End DoDot:2
+13 ;152
IF ($Y+4)>IOSL
DO HEADER
End DoDot:1
+14 ;119
IF $GET(ECPTYP)'="E"
IF 'ECOUT
DO PAGE
END ;152
DO ^ECKILL
if $DATA(ECGUI)!($GET(ECPTYP)="E")
QUIT
WRITE @IOF
DO ^%ZISC
if $DATA(ZTQUEUED)
SET ZTREQ="@"
+1 QUIT
+1 ;152
NEW I,SORT
+2 ;152
SET SORT=$SELECT(ECSM="P":"Procedure Name",ECSM="N":"Procedure Number",ECSM="C":"CPT Code",1:"CPT Inactive Date")
+3 if $EXTRACT(IOST,1,2)="C-"!(ECPG>1)
WRITE @IOF
+4 ;152
WRITE $SELECT(ECRN="N":"NATIONAL",ECRN="L":"LOCAL",1:"NATIONAL/LOCAL")_" PROCEDURE CODES WITH INACTIVE CPT CODES"
+5 ;152 center the 2nd line
WRITE ?68,"Page: ",ECPG,!?(80-(10+$LENGTH(ECRDT))\2),"Run Date : ",ECRDT,!
+6 ;152
WRITE ?(80-(9+$LENGTH(SORT))\2),"Sorted by ",SORT,!
+7 ;152 Changed "National" to "Procedure"
WRITE "Procedure",?60,"CPT",?68,"Inactive",!
+8 ;152 Change "National" to "Procedure"
WRITE "Number",?10,"Procedure Name",?60,"Code",?68,"Date",!
+9 SET ECPG=ECPG+1
+10 FOR I=1:1:80
WRITE "-"
+11 QUIT
PAGE ;
+1 NEW SS,JJ
+2 IF $DATA(ECPG)
IF $EXTRACT(IOST,1,2)="C-"
Begin DoDot:1
+3 SET SS=22-$Y
FOR JJ=1:1:SS
WRITE !
+4 SET DIR(0)="E"
WRITE !
DO ^DIR
KILL DIR
IF 'Y
SET ECOUT=1
End DoDot:1
+5 QUIT
EXPORT(PORD) ;152 - Created this tag for export format
+1 ;PORD: Print Order : Ascending or Descending.
+2 NEW I,I1,I2,LINE
+3 if '$DATA(^TMP($JOB,"ECRPT"))
QUIT
+4 MERGE ^TMP("ECINCPT",$JOB)=^TMP($JOB,"ECRPT")
+5 KILL ^TMP($JOB,"ECRPT")
+6 SET CNT=1
SET I=""
+7 SET ^TMP($JOB,"ECRPT",CNT)="PROCEDURE NUMBER^PROCEDURE NAME^CPT CODE^INACTIVE DATE"
+8 FOR
SET I=$ORDER(^TMP("ECINCPT",$JOB,I),PORD)
if I=""
QUIT
Begin DoDot:1
+9 SET I1=""
FOR
SET I1=$ORDER(^TMP("ECINCPT",$JOB,I,I1),PORD)
if I1=""
QUIT
Begin DoDot:2
+10 SET I2=""
FOR
SET I2=$ORDER(^TMP("ECINCPT",$JOB,I,I1,I2),PORD)
if I2=""
QUIT
Begin DoDot:3
+11 SET LINE=^TMP("ECINCPT",$JOB,I,I1,I2)
+12 SET CNT=CNT+1
+13 SET ^TMP($JOB,"ECRPT",CNT)=LINE
End DoDot:3
End DoDot:2
End DoDot:1
+14 KILL ^TMP("ECINCPT",$JOB)
+15 QUIT
