ECXNCL.m

ECXNCL ;ALB/DAN - Print national clinic list ;2/12/14  13:26

 ;;3.0;DSS EXTRACTS;**149,154**;Dec 22, 1997;Build 13

 N ECXPORT,DIC,L,FLDS,BY,CNT,NUM,CODE

 S ECXPORT=$$EXPORT^ECXUTL1 Q:ECXPORT=-1

 I 'ECXPORT D  Q

 .S DIC="^ECX(728.441,",L=0,(FLDS,BY)="[ECX CLINIC CODE]" D EN1^DIP

 K ^TMP($J)

 S ^TMP($J,"ECXPORT",0)="CHAR4 CODE^SHORT DESCRIPTION",CNT=1

 S CODE=0 F  S CODE=$O(^ECX(728.441,"B",CODE)) Q:CODE=""  S NUM=0 F  S NUM=$O(^ECX(728.441,"B",CODE,NUM)) Q:'+NUM  D

 .I $P($G(^ECX(728.441,NUM,2)),U)'="" Q  ;Don't show inactive codes

 .S ^TMP($J,"ECXPORT",CNT)=$G(^ECX(728.441,NUM,0)),CNT=CNT+1

 D EXPDISP^ECXUTL1

 K ^TMP($J)

 Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---ECXNCL   646     printed  Apr 09, 2024@20:59:12                                                                                                                                                                                                       Page 2

ECXNCL    ;ALB/DAN - Print national clinic list ;2/12/14  13:26

 +1       ;;3.0;DSS EXTRACTS;**149,154**;Dec 22, 1997;Build 13

 +2        NEW ECXPORT,DIC,L,FLDS,BY,CNT,NUM,CODE

 +3        SET ECXPORT=$$EXPORT^ECXUTL1

           if ECXPORT=-1

               QUIT 

 +4        IF 'ECXPORT

               Begin DoDot:1

 +5                SET DIC="^ECX(728.441,"

                   SET L=0

                   SET (FLDS,BY)="[ECX CLINIC CODE]"

                   DO EN1^DIP

               End DoDot:1

               QUIT 

 +6        KILL ^TMP($JOB)

 +7        SET ^TMP($JOB,"ECXPORT",0)="CHAR4 CODE^SHORT DESCRIPTION"

           SET CNT=1

 +8        SET CODE=0

           FOR 

               SET CODE=$ORDER(^ECX(728.441,"B",CODE))

               if CODE=""

                   QUIT 

               SET NUM=0

               FOR 

                   SET NUM=$ORDER(^ECX(728.441,"B",CODE,NUM))

                   if '+NUM

                       QUIT 

                   Begin DoDot:1

 +9       ;Don't show inactive codes

                       IF $PIECE($GET(^ECX(728.441,NUM,2)),U)'=""

                           QUIT 

 +10                   SET ^TMP($JOB,"ECXPORT",CNT)=$GET(^ECX(728.441,NUM,0))

                       SET CNT=CNT+1

                   End DoDot:1

 +11       DO EXPDISP^ECXUTL1

 +12       KILL ^TMP($JOB)

 +13       QUIT