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

ECINCPT.m

Go to the documentation of this file.
  1. 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
  1. ; Routine to report National/Local Procedure Codes with Inactive CPT
  1. ; Codes Report
  1. EN ;entry point
  1. N ZTIO,ZTDESC,ZTRTN,ECPG,ECOUT
  1. S ZTIO=ION
  1. S ZTDESC="NATIONAL/LOCAL PROCEDURE CODES WITH INACTIVE CPT"
  1. S ZTRTN="START^ECINCPT"
  1. D EN^XUTMDEVQ(ZTRTN,ZTDESC,.ZTSAVE)
  1. I POP Q
  1. I IO'=IO(0) D ^%ZISC
  1. D HOME^%ZIS
  1. Q
  1. START ; Routine execution
  1. ; Variables passed in -152
  1. ; ECPTYP - Where to send output (P)rinter, (D)evice or screen
  1. ; or (E)xport
  1. ; ECRN - Preferred Report (N-ational, L-ocal or Both)
  1. ; ECSM - Sort Method (P-rocedure Name, N-ational Number,C-PT Code,D-Inactive Date)
  1. ; ECSORT - Sort Order "A"scending, "D"escending
  1. ;
  1. ;
  1. N ECI,EC0,ECPT,ECN,ECD,ECPI,ECDT,ECPG,ECOUT,ECRDT,CNT ;119
  1. S (ECI,ECOUT)=0,ECPG=1,CNT=1 ;119
  1. N ECPTDT,ECINDX,I,NM,IEN,DATA,ECSRTBY ;152
  1. S %H=$H S ECRDT=$$HTE^XLFDT(%H,1)
  1. ;I $G(ECPTYP)="E" S ^TMP($J,"ECRPT",CNT)="NATIONAL NUMBER^NATIONAL NAME^CPT CODE^INACTIVE DATE" ;119,152 - Commented this line
  1. ;I $G(ECPTYP)'="E" D HEADER ;119,152 - Commented this line
  1. S ECSRTBY(ECSM)=$S(ECSM="P":"ECD",ECSM="N":"ECN",ECSM="C":"ECPT",1:"ECPTDT") ;152
  1. F S ECI=$O(^EC(725,ECI)) Q:'ECI D I ECOUT Q
  1. .S EC0=$G(^EC(725,ECI,0)),ECPT=$P(EC0,"^",5)
  1. .Q:EC0="" Q:ECPT=""
  1. .S ECN=$P(EC0,"^",2),ECD=$P(EC0,"^"),ECPI=$$CPT^ICPTCOD(ECPT)
  1. .Q:+ECPI<1 Q:$P(ECPI,"^",7)
  1. .;152 - Begins
  1. .I $G(ECRN)="N"&(ECI>89999) Q ; If looking for nation entries and entry has a local number, quit
  1. .I $G(ECRN)="L"&(ECI<90000) Q ; If looking for local entries and entry has a national number, quit
  1. .S ECDT=$TR($$FMTE^XLFDT($P(ECPI,"^",8),"2F")," ","0")
  1. .S ECPTDT=$P(ECPI,U,8),ECPT=$P(ECPI,U,2)
  1. .;I $G(ECPTYP)'="E" I ($Y+3)>IOSL D PAGE Q:ECOUT D HEADER ;119
  1. .;I $G(ECPTYP)="E" S CNT=CNT+1,^TMP($J,"ECRPT",CNT)=ECN_U_ECD_U_$P(ECPI,U,2)_U_ECDT Q ;119
  1. .;W !,ECN,?10,ECD,?60,$P(ECPI,"^",2),?68,ECDT
  1. .S ^TMP($J,"ECRPT",@ECSRTBY(ECSM),ECN,ECD)=ECN_U_ECD_U_$P(ECPI,U,2)_U_ECDT
  1. .;152 - Ends
  1. D PRINT(ECSORT) ;152 - Added this line
  1. ;I $G(ECPTYP)'="E" I 'ECOUT D PAGE ;119,152 - Commented this line
  1. Q
  1. PRINT(PORD) ; 152 - Added this tag to print report according to the sort order
  1. ; PORD to Print: "A"scending or "D"escending
  1. N I,I1,I2,LINE
  1. S PORD=$S(PORD="A":1,1:-1)
  1. I $G(ECPTYP)="E" D EXPORT(PORD) G END
  1. S I=""
  1. I $G(ECPTYP)'="E" D HEADER
  1. F S I=$O(^TMP($J,"ECRPT",I),PORD) Q:I="" D
  1. .S I1="" F S I1=$O(^TMP($J,"ECRPT",I,I1),PORD) Q:I1="" D
  1. ..S I2="" F S I2=$O(^TMP($J,"ECRPT",I,I1,I2),PORD) Q:I2="" D
  1. ...S LINE=^TMP($J,"ECRPT",I,I1,I2)
  1. ...W !,$P(LINE,U),?10,$P(LINE,U,2),?60,$P(LINE,U,3),?68,$P(LINE,U,4)
  1. ...I ($Y+4)>IOSL D HEADER ;D PAGE Q:ECOUT D HEADER ;152
  1. .I ($Y+4)>IOSL D HEADER ;152
  1. I $G(ECPTYP)'="E" I 'ECOUT D PAGE ;119
  1. END D ^ECKILL Q:$D(ECGUI)!($G(ECPTYP)="E") W @IOF D ^%ZISC S:$D(ZTQUEUED) ZTREQ="@" ;152
  1. Q
  1. N I,SORT ;152
  1. S SORT=$S(ECSM="P":"Procedure Name",ECSM="N":"Procedure Number",ECSM="C":"CPT Code",1:"CPT Inactive Date") ;152
  1. W:$E(IOST,1,2)="C-"!(ECPG>1) @IOF
  1. W $S(ECRN="N":"NATIONAL",ECRN="L":"LOCAL",1:"NATIONAL/LOCAL")_" PROCEDURE CODES WITH INACTIVE CPT CODES" ;152
  1. W ?68,"Page: ",ECPG,!?(80-(10+$L(ECRDT))\2),"Run Date : ",ECRDT,! ;152 center the 2nd line
  1. W ?(80-(9+$L(SORT))\2),"Sorted by ",SORT,! ;152
  1. W "Procedure",?60,"CPT",?68,"Inactive",! ;152 Changed "National" to "Procedure"
  1. W "Number",?10,"Procedure Name",?60,"Code",?68,"Date",! ;152 Change "National" to "Procedure"
  1. S ECPG=ECPG+1
  1. F I=1:1:80 W "-"
  1. Q
  1. PAGE ;
  1. N SS,JJ
  1. I $D(ECPG),$E(IOST,1,2)="C-" D
  1. . S SS=22-$Y F JJ=1:1:SS W !
  1. . S DIR(0)="E" W ! D ^DIR K DIR I 'Y S ECOUT=1
  1. Q
  1. EXPORT(PORD) ;152 - Created this tag for export format
  1. ;PORD: Print Order : Ascending or Descending.
  1. N I,I1,I2,LINE
  1. Q:'$D(^TMP($J,"ECRPT"))
  1. M ^TMP("ECINCPT",$J)=^TMP($J,"ECRPT")
  1. K ^TMP($J,"ECRPT")
  1. S CNT=1,I=""
  1. S ^TMP($J,"ECRPT",CNT)="PROCEDURE NUMBER^PROCEDURE NAME^CPT CODE^INACTIVE DATE"
  1. F S I=$O(^TMP("ECINCPT",$J,I),PORD) Q:I="" D
  1. .S I1="" F S I1=$O(^TMP("ECINCPT",$J,I,I1),PORD) Q:I1="" D
  1. ..S I2="" F S I2=$O(^TMP("ECINCPT",$J,I,I1,I2),PORD) Q:I2="" D
  1. ...S LINE=^TMP("ECINCPT",$J,I,I1,I2)
  1. ...S CNT=CNT+1
  1. ...S ^TMP($J,"ECRPT",CNT)=LINE
  1. K ^TMP("ECINCPT",$J)
  1. Q