- 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 Jan 18, 2025@02:54:18 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