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

ECDSS1.m

Go to the documentation of this file.
  1. 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
  1. ; Routine to report active and inactive procedures
  1. START ; Routine execution
  1. N ECRAS S ECRAS=1 ;roll and scroll
  1. S DIR(0)="SO^A:Active Procedures;I:Inactive Procedures"
  1. S DIR("A")="Select Report"
  1. S DIR("?")="Enter an A for active procedures, I for inactive procedures, or ^ to quit."
  1. S DIR("??")="ECDSS1^"
  1. D ^DIR K DIR I $D(DIRUT) G END
  1. S ECRTN=Y
  1. INACT ;list inact procs
  1. I ECRTN="I" D LISTI G END
  1. ASK ;
  1. S DIR(0)="SO^N:National;L:Local;B:Both",DIR("A")="Select Preferred Report"
  1. S DIR("?,1")="Enter an N for National Procedures only, L for Local Procedures only,"
  1. S DIR("?")="B for a combined report, or ^ to quit."
  1. S DIR("??")="ECDSAC^" D ^DIR K DIR I $D(DIRUT) G END
  1. S ECRN=Y
  1. SORT ;ask sort
  1. S DIR(0)="SO^P:Procedure Name;N:National Number",DIR("A")="Select Sort Method"
  1. S DIR("?")="Enter N to sort by National Number, P by Procedure Name, or ^ to quit."
  1. S DIR("??")="ECDSAC1^" D ^DIR K DIR I $D(DIRUT) G END
  1. S ECRD=Y
  1. PRT ;start prints
  1. I $G(ECPTYP)="E" D EXPORT,^ECKILL Q ;119
  1. I ECRN="N",ECRD="N" D LISTNN G END
  1. I ECRN="N",ECRD="P" D LISTNP G END
  1. I ECRN="L",ECRD="N" D LISTPN G END
  1. I ECRN="L",ECRD="P" D LISTPP G END
  1. I ECRN="B",ECRD="N" D LISTBN G END
  1. I ECRN="B",ECRD="P" D LISTBP
  1. END ;kills var and quit
  1. W @IOF D ^ECKILL
  1. Q
  1. LISTI ;all inact proc
  1. I $G(ECPTYP)="E" D EXPORT,^ECKILL Q ;119
  1. 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
  1. D MSG
  1. Q
  1. LISTNN ;nat only by nat num
  1. 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
  1. D MSG
  1. Q
  1. LISTNP ;nat only by proc
  1. 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
  1. D MSG
  1. Q
  1. LISTPN ;loc by nat num
  1. 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
  1. D MSG
  1. Q
  1. LISTPP ;loc by proc
  1. 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
  1. D MSG
  1. Q
  1. LISTBN ;both by nat num
  1. 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
  1. D MSG
  1. Q
  1. LISTBP ;both by proc
  1. 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
  1. D MSG
  1. Q
  1. MSG I $D(ECRAS) W !!,"Press <RET> to continue " R X:DTIME
  1. Q
  1. ;
  1. EXPORT ;Section added in patch 119
  1. N CNT,I,NM,DATA,IEN,INDEX
  1. 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
  1. 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
  1. .S IEN=I_","
  1. .D GETS^DIQ(725,IEN,".01;1;2;4",,"DATA")
  1. .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
  1. .I $G(ECRTN)="A"&(DATA(725,IEN,2)="") D ;If sort by active and entry is active, continue processing
  1. ..I $G(ECRN)="N"&(I>89999) Q ;If looking for nation entries and entry has a local number, quit
  1. ..I $G(ECRN)="L"&(I<90000) Q ;If looking for local entries and entry has a national number, quit
  1. ..;assume record should be counted
  1. ..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))
  1. Q