- 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 Feb 18, 2025@23:23:33 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