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 ---[H[J[2J[HECXNCL 646 printed Dec 13, 2024@01:53:05 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
