ECDSS1 ;BIR/RHK,JPW - Active/Inactive Procedure Report ;1/11/21 16:50
;;2.0;EVENT CAPTURE;**4,25,95,119,152**;8 May 96;Build 19
; Routine to report active and inactive procedures
START ; Routine execution
N ECRAS S ECRAS=1 ;roll and scroll
S DIR(0)="SO^A:Active Procedures;I:Inactive Procedures"
S DIR("A")="Select Report"
S DIR("?")="Enter an A for active procedures, I for inactive procedures, or ^ to quit."
S DIR("??")="ECDSS1^"
D ^DIR K DIR I $D(DIRUT) G END
S ECRTN=Y
INACT ;list inact procs
I ECRTN="I" D LISTI G END
ASK ;
S DIR(0)="SO^N:National;L:Local;B:Both",DIR("A")="Select Preferred Report"
S DIR("?,1")="Enter an N for National Procedures only, L for Local Procedures only,"
S DIR("?")="B for a combined report, or ^ to quit."
S DIR("??")="ECDSAC^" D ^DIR K DIR I $D(DIRUT) G END
S ECRN=Y
SORT ;ask sort
S DIR(0)="SO^P:Procedure Name;N:National Number",DIR("A")="Select Sort Method"
S DIR("?")="Enter N to sort by National Number, P by Procedure Name, or ^ to quit."
S DIR("??")="ECDSAC1^" D ^DIR K DIR I $D(DIRUT) G END
S ECRD=Y
PRT ;start prints
I $G(ECPTYP)="E" D EXPORT,^ECKILL Q ;119
I ECRN="N",ECRD="N" D LISTNN G END
I ECRN="N",ECRD="P" D LISTNP G END
I ECRN="L",ECRD="N" D LISTPN G END
I ECRN="L",ECRD="P" D LISTPP G END
I ECRN="B",ECRD="N" D LISTBN G END
I ECRN="B",ECRD="P" D LISTBP
END ;kills var and quit
W @IOF D ^ECKILL
Q
LISTI ;all inact proc
I $G(ECPTYP)="E" D EXPORT,^ECKILL Q ;119
W ! K DIC S DIC="^EC(725,",FLDS=".01;""PROCEDURE NAME"",1;""PROCEDURE NUMBER"",4,2",BY=".01",(FR,TO)="",L=0,DHD="NATIONAL/LOCAL PROCEDURE REPORT - INACTIVE",DIS(0)="I +$P(^EC(725,D0,0),""^"",3)" D EN1^DIP ;152
D MSG
Q
LISTNN ;nat only by nat num
W ! K DIC S DIC="^EC(725,",FLDS="1;""PROCEDURE NUMBER"",4,.01;""PROCEDURE NAME""",BY="1",(FR,TO)="",L=0,DHD="NATIONAL/LOCAL PROCEDURE REPORT - ACTIVE NATIONAL BY PROCEDURE NUMBER",DIS(0)="I D0<90000,'$P(^EC(725,D0,0),""^"",3)" D EN1^DIP ;152
D MSG
Q
LISTNP ;nat only by proc
W ! K DIC S DIC="^EC(725,",FLDS=".01;""PROCEDURE NAME"",1;""PROCEDURE NUMBER"",4",BY=".01",(FR,TO)="",L=0,DHD="NATIONAL/LOCAL PROCEDURE REPORT - ACTIVE NATIONAL BY PROCEDURE NAME",DIS(0)="I D0<90000,'$P(^EC(725,D0,0),""^"",3)" D EN1^DIP ;152
D MSG
Q
LISTPN ;loc by nat num
W ! K DIC S DIC="^EC(725,",FLDS="1;""PROCEDURE NUMBER"",4,.01;""PROCEDURE NAME""",BY="1",(FR,TO)="",L=0,DHD="NATIONAL/LOCAL PROCEDURE REPORT - ACTIVE LOCAL BY PROCEDURE NUMBER",DIS(0)="I D0>89999,'$P(^EC(725,D0,0),""^"",3)" D EN1^DIP ;152
D MSG
Q
LISTPP ;loc by proc
W ! K DIC S DIC="^EC(725,",FLDS=".01;""PROCEDURE NAME"",1;""PROCEDURE NUMBER"",4",BY=".01",(FR,TO)="",L=0,DHD="NATIONAL/LOCAL PROCEDURE REPORT - ACTIVE LOCAL BY PROCEDURE NAME",DIS(0)="I D0>89999,'$P(^EC(725,D0,0),""^"",3)" D EN1^DIP ;152
D MSG
Q
LISTBN ;both by nat num
W ! K DIC S DIC="^EC(725,",FLDS="1;""PROCEDURE NUMBER"",4,.01;""PROCEDURE NAME""",BY="1",(FR,TO)="",L=0,DHD="NATIONAL/LOCAL PROCEDURE REPORT - ACTIVE NATIONAL AND LOCAL BY PROCEDURE NUMBER",DIS(0)="I '$P(^EC(725,D0,0),""^"",3)" D EN1^DIP ;152
D MSG
Q
LISTBP ;both by proc
W ! K DIC S DIC="^EC(725,",FLDS=".01;""PROCEDURE NAME"",1;""PROCEDURE NUMBER"",4",BY=".01",(FR,TO)="",L=0,DHD="NATIONAL/LOCAL PROCEDURE REPORT - ACTIVE NATIONAL AND LOCAL BY PROCEDURE NAME",DIS(0)="I '$P(^EC(725,D0,0),""^"",3)" D EN1^DIP ;152
D MSG
Q
MSG I $D(ECRAS) W !!,"Press <RET> to continue " R X:DTIME
Q
;
EXPORT ;Section added in patch 119
N CNT,I,NM,DATA,IEN,INDEX
S CNT=1,^TMP($J,"ECRPT",CNT)=$S($G(ECRD)="N":"PROCEDURE NUMBER^CPT^PROCEDURE NAME",1:"PROCEDURE NAME^PROCEDURE NUMBER^CPT")_$S($G(ECRTN)="I":"^INACTIVE DATE",1:"") ;152
S NM="",INDEX=$S($G(ECRD)="N":"E",1:"B") F S NM=$O(^EC(725,INDEX,NM)) Q:NM="" S I=0 F S I=$O(^EC(725,INDEX,NM,I)) Q:'+I D K DATA
.S IEN=I_","
.D GETS^DIQ(725,IEN,".01;1;2;4",,"DATA")
.I $G(ECRTN)="I"&(DATA(725,IEN,2)'="") S CNT=CNT+1,^TMP($J,"ECRPT",CNT)=DATA(725,IEN,.01)_U_DATA(725,IEN,1)_U_DATA(725,IEN,4)_U_DATA(725,IEN,2) Q ;If sort by inactive and entry is inactive, store record
.I $G(ECRTN)="A"&(DATA(725,IEN,2)="") D ;If sort by active and entry is active, continue processing
..I $G(ECRN)="N"&(I>89999) Q ;If looking for nation entries and entry has a local number, quit
..I $G(ECRN)="L"&(I<90000) Q ;If looking for local entries and entry has a national number, quit
..;assume record should be counted
..S CNT=CNT+1,^TMP($J,"ECRPT",CNT)=$S($G(ECRD)="N":DATA(725,IEN,1)_U_DATA(725,IEN,4)_U_DATA(725,IEN,.01),1:DATA(725,IEN,.01)_U_DATA(725,IEN,1)_U_DATA(725,IEN,4))
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HECDSS1 4596 printed Apr 09, 2024@21:01:45 Page 2
ECDSS1 ;BIR/RHK,JPW - Active/Inactive Procedure Report ;1/11/21 16:50
+1 ;;2.0;EVENT CAPTURE;**4,25,95,119,152**;8 May 96;Build 19
+2 ; Routine to report active and inactive procedures
START ; Routine execution
+1 ;roll and scroll
NEW ECRAS
SET ECRAS=1
+2 SET DIR(0)="SO^A:Active Procedures;I:Inactive Procedures"
+3 SET DIR("A")="Select Report"
+4 SET DIR("?")="Enter an A for active procedures, I for inactive procedures, or ^ to quit."
+5 SET DIR("??")="ECDSS1^"
+6 DO ^DIR
KILL DIR
IF $DATA(DIRUT)
GOTO END
+7 SET ECRTN=Y
INACT ;list inact procs
+1 IF ECRTN="I"
DO LISTI
GOTO END
ASK ;
+1 SET DIR(0)="SO^N:National;L:Local;B:Both"
SET DIR("A")="Select Preferred Report"
+2 SET DIR("?,1")="Enter an N for National Procedures only, L for Local Procedures only,"
+3 SET DIR("?")="B for a combined report, or ^ to quit."
+4 SET DIR("??")="ECDSAC^"
DO ^DIR
KILL DIR
IF $DATA(DIRUT)
GOTO END
+5 SET ECRN=Y
SORT ;ask sort
+1 SET DIR(0)="SO^P:Procedure Name;N:National Number"
SET DIR("A")="Select Sort Method"
+2 SET DIR("?")="Enter N to sort by National Number, P by Procedure Name, or ^ to quit."
+3 SET DIR("??")="ECDSAC1^"
DO ^DIR
KILL DIR
IF $DATA(DIRUT)
GOTO END
+4 SET ECRD=Y
PRT ;start prints
+1 ;119
IF $GET(ECPTYP)="E"
DO EXPORT
DO ^ECKILL
QUIT
+2 IF ECRN="N"
IF ECRD="N"
DO LISTNN
GOTO END
+3 IF ECRN="N"
IF ECRD="P"
DO LISTNP
GOTO END
+4 IF ECRN="L"
IF ECRD="N"
DO LISTPN
GOTO END
+5 IF ECRN="L"
IF ECRD="P"
DO LISTPP
GOTO END
+6 IF ECRN="B"
IF ECRD="N"
DO LISTBN
GOTO END
+7 IF ECRN="B"
IF ECRD="P"
DO LISTBP
END ;kills var and quit
+1 WRITE @IOF
DO ^ECKILL
+2 QUIT
LISTI ;all inact proc
+1 ;119
IF $GET(ECPTYP)="E"
DO EXPORT
DO ^ECKILL
QUIT
+2 ;152
WRITE !
KILL DIC
SET DIC="^EC(725,"
SET FLDS=".01;""PROCEDURE NAME"",1;""PROCEDURE NUMBER"",4,2"
SET BY=".01"
SET (FR,TO)=""
SET L=0
SET DHD="NATIONAL/LOCAL PROCEDURE REPORT - INACTIVE"
SET DIS(0)="I +$P(^EC(725,D0,0),""^"",3)"
DO EN1^DIP
+3 DO MSG
+4 QUIT
LISTNN ;nat only by nat num
+1 ;152
WRITE !
KILL DIC
SET DIC="^EC(725,"
SET FLDS="1;""PROCEDURE NUMBER"",4,.01;""PROCEDURE NAME"""
SET BY="1"
SET (FR,TO)=""
SET L=0
SET DHD="NATIONAL/LOCAL PROCEDURE REPORT - ACTIVE NATIONAL BY PROCEDURE NUMBER"
SET DIS(0)="I D0<90000,'$P(^EC(725,D0,0),""^"",3)"
DO EN1^DIP
+2 DO MSG
+3 QUIT
LISTNP ;nat only by proc
+1 ;152
WRITE !
KILL DIC
SET DIC="^EC(725,"
SET FLDS=".01;""PROCEDURE NAME"",1;""PROCEDURE NUMBER"",4"
SET BY=".01"
SET (FR,TO)=""
SET L=0
SET DHD="NATIONAL/LOCAL PROCEDURE REPORT - ACTIVE NATIONAL BY PROCEDURE NAME"
SET DIS(0)="I D0<90000,'$P(^EC(725,D0,0),""^"",3)"
DO EN1^DIP
+2 DO MSG
+3 QUIT
LISTPN ;loc by nat num
+1 ;152
WRITE !
KILL DIC
SET DIC="^EC(725,"
SET FLDS="1;""PROCEDURE NUMBER"",4,.01;""PROCEDURE NAME"""
SET BY="1"
SET (FR,TO)=""
SET L=0
SET DHD="NATIONAL/LOCAL PROCEDURE REPORT - ACTIVE LOCAL BY PROCEDURE NUMBER"
SET DIS(0)="I D0>89999,'$P(^EC(725,D0,0),""^"",3)"
DO EN1^DIP
+2 DO MSG
+3 QUIT
LISTPP ;loc by proc
+1 ;152
WRITE !
KILL DIC
SET DIC="^EC(725,"
SET FLDS=".01;""PROCEDURE NAME"",1;""PROCEDURE NUMBER"",4"
SET BY=".01"
SET (FR,TO)=""
SET L=0
SET DHD="NATIONAL/LOCAL PROCEDURE REPORT - ACTIVE LOCAL BY PROCEDURE NAME"
SET DIS(0)="I D0>89999,'$P(^EC(725,D0,0),""^"",3)"
DO EN1^DIP
+2 DO MSG
+3 QUIT
LISTBN ;both by nat num
+1 ;152
WRITE !
KILL DIC
SET DIC="^EC(725,"
SET FLDS="1;""PROCEDURE NUMBER"",4,.01;""PROCEDURE NAME"""
SET BY="1"
SET (FR,TO)=""
SET L=0
SET DHD="NATIONAL/LOCAL PROCEDURE REPORT - ACTIVE NATIONAL AND LOCAL BY PROCEDURE NUMBER"
SET DIS(0)="I '$P(^EC(725,D0,0),""^"",3)"
DO EN1^DIP
+2 DO MSG
+3 QUIT
LISTBP ;both by proc
+1 ;152
WRITE !
KILL DIC
SET DIC="^EC(725,"
SET FLDS=".01;""PROCEDURE NAME"",1;""PROCEDURE NUMBER"",4"
SET BY=".01"
SET (FR,TO)=""
SET L=0
SET DHD="NATIONAL/LOCAL PROCEDURE REPORT - ACTIVE NATIONAL AND LOCAL BY PROCEDURE NAME"
SET DIS(0)="I '$P(^EC(725,D0,0),""^"",3)"
DO EN1^DIP
+2 DO MSG
+3 QUIT
MSG IF $DATA(ECRAS)
WRITE !!,"Press <RET> to continue "
READ X:DTIME
+1 QUIT
+2 ;
EXPORT ;Section added in patch 119
+1 NEW CNT,I,NM,DATA,IEN,INDEX
+2 ;152
SET CNT=1
SET ^TMP($JOB,"ECRPT",CNT)=$SELECT($GET(ECRD)="N":"PROCEDURE NUMBER^CPT^PROCEDURE NAME",1:"PROCEDURE NAME^PROCEDURE NUMBER^CPT")_$SELECT($GET(ECRTN)="I":"^INACTIVE DATE",1:"")
+3 SET NM=""
SET INDEX=$SELECT($GET(ECRD)="N":"E",1:"B")
FOR
SET NM=$ORDER(^EC(725,INDEX,NM))
if NM=""
QUIT
SET I=0
FOR
SET I=$ORDER(^EC(725,INDEX,NM,I))
if '+I
QUIT
Begin DoDot:1
+4 SET IEN=I_","
+5 DO GETS^DIQ(725,IEN,".01;1;2;4",,"DATA")
+6 ;If sort by inactive and entry is inactive, store record
IF $GET(ECRTN)="I"&(DATA(725,IEN,2)'="")
SET CNT=CNT+1
SET ^TMP($JOB,"ECRPT",CNT)=DATA(725,IEN,.01)_U_DATA(725,IEN,1)_U_DATA(725,IEN,4)_U_DATA(725,IEN,2)
QUIT
+7 ;If sort by active and entry is active, continue processing
IF $GET(ECRTN)="A"&(DATA(725,IEN,2)="")
Begin DoDot:2
+8 ;If looking for nation entries and entry has a local number, quit
IF $GET(ECRN)="N"&(I>89999)
QUIT
+9 ;If looking for local entries and entry has a national number, quit
IF $GET(ECRN)="L"&(I<90000)
QUIT
+10 ;assume record should be counted
+11 SET CNT=CNT+1
SET ^TMP($JOB,"ECRPT",CNT)=$SELECT($GET(ECRD)="N":DATA(725,IEN,1)_U_DATA(725,IEN,4)_U_DATA(725,IEN,.01),1:DATA(725,IEN,.01)_U_DATA(725,IEN,1)_U_DATA(725,IEN,4))
End DoDot:2
End DoDot:1
KILL DATA
+12 QUIT
