Routine: SCMCNPER

SCMCNPER ;ALB/ART - PCMM Web Query New Person file ; 03/13/2015

 ;;5.3;Scheduling;**603,811**;Aug 13, 1993;Build 3

 QUIT

 ;Cloned from XUPSQRY - PCMM Web needs Application Proxy Access

 ;added new parameter to lookup by DUZ, and add phone and pager to return

 ;don't filter out inactive, return info to PCMM Web

 ;Public, Supported ICRs

 ; #1625  - PERSON CLASS API'S

 ; #2343  - DBIA2343 (XUSER)

 ; #4574  - XUPS APIs

 ; #10000 - Classic FileMan API: Date/Time Manipulation (%DTC)

 ; #10060 - NEW PERSON FILE

 ; #10106 - HLFNC (HL7 APIs)

 ; #10112 - VASITE - Supported APIs for site info

 ;XUPSQRY ;EDS/GRR - Query New Person file ;4/9/04  10:40

 ;;8.0;KERNEL;**325**; Jul 10, 1995

 ;Input Parameter:

 ;   SCMCVPID - VPID of the user (Required for lookup by VPID)

 ;   SCMCDUZ  - File 200 IEN (Required for lookup by IEN)

 ;   SCMCLNAM - Part or all of the last name to use for basis

 ;              of query (Required for lookup by name)

 ;   SCMCFNAM - Part or all of the first name to use for basis

 ;              of query filter (optional, can be null)

 ;   SCMCSSN  - Social Security Number (null or full 9 digits) to

 ;              use as additional filter for query

 ;   SCMCPROV - If value set to "P", screen for only providers

 ;              (only persons with active person class)

 ;   SCMCSTN  - Filter persons based on station number entered

 ;              (optional, can be null)  This parameter is no longer used, but left as a place holder.

 ;   SCMCMNM  - Maximum Number of entries to return (*811 - parameter no longer used)

 ;              (Number between 1 and 50.  Null defaults to "*", all results)

 ;   SCMCDATE - Date to be used to determine whether person has

 ;              active person class.  If null, current date is used.

 ;Output:

 ;   RESULT - Name of global array were output data is stored

 ;            ^TMP($J,"SCMCQRY",1) - 1 if found, 0 if not found

 ;            ^TMP($J,"SCMCQRY",n,0) - VPID^IEN^Last Name~First Name~Middle Name^SSN^DOB^SEX^Phone^Pager^

 ;            ^TMP($J,"SCMCQRY",n,1) - Provider Type^

 ;            ^TMP($J,"SCMCQRY",n,2) - Provider Classification^

 ;            ^TMP($J,"SCMCQRY",n,3) - Provider Area of Specialization^

 ;            ^TMP($J,"SCMCQRY",n,4) - VA CODE^X12 CODE^Specialty Code

 ;            ^TMP($J,"SCMCQRY",n,5) - Result of call to $$ACTIVE^XUSER(SCMCIEN)^end-of-record character "|"

EN1(RESULT,SCMCVPID,SCMCDUZ,SCMCLNAM,SCMCFNAM,SCMCSSN,SCMCPROV,SCMCSTN,SCMCMNM,SCMCDATE) ;

 N %,SCMCNDAT

 K ^TMP($J,"SCMCQRY")

 K RESULT

 S RESULT=$NA(^TMP($J,"SCMCQRY")) ;set variable to name of global array where output data will be stored

 S ^TMP($J,"SCMCQRY",1)=0 ;initialize to not found

 I $G(SCMCLNAM)="",($G(SCMCVPID)=""),($G(SCMCDUZ)="") Q  ;one of the 3 lookup parameters is required

 S SCMCFNAM=$G(SCMCFNAM)  ;Set to null if missing

 S SCMCSSN=$G(SCMCSSN)  ;Set to null if missing

 S SCMCPROV=$G(SCMCPROV)  ;Set to null if missing

 S SCMCSTN=$G(SCMCSTN)  ;Set to null if missing

 I $G(SCMCDATE)="" S SCMCDATE="" ;set to null if missing

 D NOW^%DTC

 S SCMCNDAT=%\1 ;set date to today and truncate time

 S SCMCDATE=$S(SCMCDATE="":SCMCNDAT,1:$$FMDATE^HLFNC(SCMCDATE)) ;change date from hl7 format to fileman format

 N SCMCCNT,SCMCNAME,SCMCIEN,SCMCDOB,SCMCSEX,SCMCPC,SCMCX12,SCMCPASS ;initialize new set of variables

 S:$G(SCMCMNM)="" SCMCMNM="*" ;set to default ; *811 - setting default to all results (parameter no longer used)

 S SCMCCNT=0 ;Initialize variable

 ;Lookup by VPID

 I $G(SCMCVPID)'="" D  Q

 .S SCMCIEN=$$IEN^XUPS(SCMCVPID)

 .I +SCMCIEN>0 D

 ..D FILTER

 ..Q:SCMCPASS=0

 ..S SCMCCNT=SCMCCNT+1

 ..D FOUND(SCMCCNT,SCMCIEN,SCMCDATE) ;set array with person data

 ;Lookup by DUZ

 I $G(SCMCDUZ)'="" D  Q

 .Q:$$GET1^DIQ(200,SCMCDUZ_",",.01,"I")=""

 .S SCMCIEN=SCMCDUZ

 .D FILTER

 .Q:SCMCPASS=0

 .S SCMCCNT=SCMCCNT+1

 .D FOUND(SCMCCNT,SCMCIEN,SCMCDATE) ;set array with person data

 ;Lookup by name

 S SCMCIEN=0,SCMCNAME=SCMCLNAM ;initialize variables

 N SCMCRET,SCMCMSG,SCI

 D FIND^DIC(200,,"@;.01","PQ",SCMCLNAM,"*","B",,,"SCMCRET","SCMCMSG") ;* 811 - modifying to return all results "*" (was 500)

 S SCI=0

 F  S SCI=$O(SCMCRET("DILIST",SCI)) Q:SCI=""  D

 .S SCMCIEN=$P(SCMCRET("DILIST",SCI,0),U,1)

 .D FILTER

 .Q:SCMCPASS=0

 .S SCMCCNT=SCMCCNT+1

 .D FOUND(SCMCCNT,SCMCIEN,SCMCDATE) ;set array with person data

FILTER ;

 S SCMCPASS=1 ;initialize found flag to found

 I SCMCFNAM]"" S SCMCPASS=$$NMATCH(SCMCIEN,SCMCFNAM) ;check if matches name filter

 Q:'SCMCPASS  ;failed to match

 I SCMCSSN]"",($$GET1^DIQ(200,SCMCIEN_",",9)'=SCMCSSN) S SCMCPASS=0 Q  ;check ssn filter

 ;possible future use

 ;I SCMCSTN]"" S SCMCPASS=$$STNMAT(SCMCIEN,SCMCSTN) ;check station number

 ;Q:'SCMCPASS  ;failed match

 I SCMCPROV]"",($$GET^XUA4A72(SCMCIEN,SCMCDATE)<0) S SCMCPASS=0 Q  ;check if active person class

FOUND(SCMCCNT,SCMCIEN,SCMCDATE) ;format output array

 N SCMCNAME,SCMCSSN,SCMCVPID,SCMCSEX,SCMCDOB,SCMCPHON,SCMCPAGR,I,Y

 S Y=$$GET1^DIQ(200,SCMCIEN_",",.01) ;get full name

 S SCMCNAME=$$HLNAME^HLFNC(Y,"~|\/") ;format name into last name~first name~middle name

 I $L(SCMCNAME,"~")<3 S $P(SCMCNAME,"~",3)="" ;make sure formatted name has all 3 pieces

 S SCMCSSN=$$GET1^DIQ(200,SCMCIEN_",",9) ;ssn

 S SCMCVPID=$$GET1^DIQ(200,SCMCIEN_",",9000) ;vpid

 S SCMCSEX=$$GET1^DIQ(200,SCMCIEN_",",4,"I") ;sex

 S SCMCDOB=$$GET1^DIQ(200,SCMCIEN_",",5,"I") ;dob fileman format

 I SCMCDOB]"" S SCMCDOB=$$HLDATE^HLFNC(SCMCDOB,"DT") ;format dob to correct hl7 format yyyymmdd

 S SCMCPHON=$$GET1^DIQ(200,SCMCIEN_",",.132) ;office phone

 S SCMCPAGR=$$GET1^DIQ(200,SCMCIEN_",",.138) ;digital pager

 S ^TMP($J,"SCMCQRY",1)=1 ;set to indicate match found

 S ^TMP($J,"SCMCQRY",SCMCCNT,0)=SCMCVPID_"^"_SCMCIEN_"^"_SCMCNAME_"^"_SCMCSSN_"^"_SCMCDOB_"^"_SCMCSEX_"^"_SCMCPHON_"^"_SCMCPAGR_"^"

 S SCMCPC=$$GET^XUA4A72(SCMCIEN,SCMCDATE) ;get active person class data

 S:SCMCPC<0 SCMCPC="" ;no active person class

 F I=1:1:3 S ^TMP($J,"SCMCQRY",SCMCCNT,I)=$P(SCMCPC,"^",(1+I))_"^" ;put provider type, provider class, and are of specialization in output array

 S SCMCX12="" ;PCMM Web does not use this - 603

 S ^TMP($J,"SCMCQRY",SCMCCNT,4)=$P(SCMCPC,"^",7)_"^"_SCMCX12_"^"_$P(SCMCPC,"^",8)_"^" ;put va code, x12 code, specialty code

 S ^TMP($J,"SCMCQRY",SCMCCNT,5)=$$ACTIVE^XUSER(SCMCIEN)_"^|" ;603

NMATCH(SCMCIEN,SCMCFNAM) ;

 ;Match on First Name

 ;Input Parameters:

 ;      SCMCIEN - Internal Entry Number of New Person entry

 ;     SCMCFNAM - Part or all of Person first name

 ;Output:

 ;      SCMCOUT - 1 if name matched, 0 if name did not match

 N SCMCA,SCMCHFN,SCMCFN,SCMCNFN,SCMCOUT ;establish new variables

 S SCMCFN=$$GET1^DIQ(200,SCMCIEN_",",.01) ;get full name

 S SCMCHFN=$$HLNAME^HLFNC(SCMCFN,"~|\/") ;change to HL7 format (last name~first name~middle name)

 S SCMCNFN=$P(SCMCHFN,"~",2) ;get first name

 S SCMCOUT=$S($E(SCMCNFN,1,$L(SCMCFNAM))[SCMCFNAM:1,1:0) ; match first name to first name passed

 Q SCMCOUT  ;return 1 if name matched, 0 if no match

 ;STNMAT(SCMCIEN,SCMCSTN) ;Station Number matching (possible future use)

 ;Input Parameters:

 ;     SCMCIEN - Internal Entry Number of New Person entry

 ;     SCMCSTN - 3-6 character station number to use as screen

 ;               (i.e. 603 or 528A4)

 ;Output:

 ;     SCMCOUT - 1 if station matched, 0 if no station match

 ; NOTE: If this code is ever used, needs to be tested and subscription to ICR 4055

 ;NEW SCMCOUT,SCMCRET,SCI,SCHIT

 ;SET SCMCOUT=0

 ;DO DIVGET^XUSRB2(.SCMCRET,SCMCIEN)

 ;IF +SCMCRET(0)'=0 DO

 ;. SET SCHIT=0

 ;. SET SCI=""

 ;. FOR  SET SCI=$ORDER(SCMCRET(SCI)) QUIT:SCI=""!(SCHIT)  DO

 ;. . IF $PIECE(SCMCRET(SCI),U,3)=SCMCSTN DO

 ;. . . SET SCMCOUT=1

 ;. . . SET SCHIT=1

 ;QUIT SCMCOUT  ;return 1 if match, 0 if no match

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSCMCNPER   7888     printed  Mar 13, 2025@21:46                                                                                                                                                                                                       Page 2

SCMCNPER  ;ALB/ART - PCMM Web Query New Person file ; 03/13/2015

 +1       ;;5.3;Scheduling;**603,811**;Aug 13, 1993;Build 3

 +2       ;

 +3        QUIT

 +4       ;

 +5       ;Cloned from XUPSQRY - PCMM Web needs Application Proxy Access

 +6       ;added new parameter to lookup by DUZ, and add phone and pager to return

 +7       ;don't filter out inactive, return info to PCMM Web

 +8       ;

 +9       ;Public, Supported ICRs

 +10      ; #1625  - PERSON CLASS API'S

 +11      ; #2343  - DBIA2343 (XUSER)

 +12      ; #4574  - XUPS APIs

 +13      ; #10000 - Classic FileMan API: Date/Time Manipulation (%DTC)

 +14      ; #10060 - NEW PERSON FILE

 +15      ; #10106 - HLFNC (HL7 APIs)

 +16      ; #10112 - VASITE - Supported APIs for site info

 +17      ;

 +18      ;XUPSQRY ;EDS/GRR - Query New Person file ;4/9/04  10:40

 +19      ;;8.0;KERNEL;**325**; Jul 10, 1995

 +20      ;

 +21      ;Input Parameter:

 +22      ;   SCMCVPID - VPID of the user (Required for lookup by VPID)

 +23      ;   SCMCDUZ  - File 200 IEN (Required for lookup by IEN)

 +24      ;   SCMCLNAM - Part or all of the last name to use for basis

 +25      ;              of query (Required for lookup by name)

 +26      ;   SCMCFNAM - Part or all of the first name to use for basis

 +27      ;              of query filter (optional, can be null)

 +28      ;   SCMCSSN  - Social Security Number (null or full 9 digits) to

 +29      ;              use as additional filter for query

 +30      ;   SCMCPROV - If value set to "P", screen for only providers

 +31      ;              (only persons with active person class)

 +32      ;   SCMCSTN  - Filter persons based on station number entered

 +33      ;              (optional, can be null)  This parameter is no longer used, but left as a place holder.

 +34      ;   SCMCMNM  - Maximum Number of entries to return (*811 - parameter no longer used)

 +35      ;              (Number between 1 and 50.  Null defaults to "*", all results)

 +36      ;   SCMCDATE - Date to be used to determine whether person has

 +37      ;              active person class.  If null, current date is used.

 +38      ;

 +39      ;Output:

 +40      ;   RESULT - Name of global array were output data is stored

 +41      ;            ^TMP($J,"SCMCQRY",1) - 1 if found, 0 if not found

 +42      ;            ^TMP($J,"SCMCQRY",n,0) - VPID^IEN^Last Name~First Name~Middle Name^SSN^DOB^SEX^Phone^Pager^

 +43      ;            ^TMP($J,"SCMCQRY",n,1) - Provider Type^

 +44      ;            ^TMP($J,"SCMCQRY",n,2) - Provider Classification^

 +45      ;            ^TMP($J,"SCMCQRY",n,3) - Provider Area of Specialization^

 +46      ;            ^TMP($J,"SCMCQRY",n,4) - VA CODE^X12 CODE^Specialty Code

 +47      ;            ^TMP($J,"SCMCQRY",n,5) - Result of call to $$ACTIVE^XUSER(SCMCIEN)^end-of-record character "|"

 +48      ;

EN1(RESULT,SCMCVPID,SCMCDUZ,SCMCLNAM,SCMCFNAM,SCMCSSN,SCMCPROV,SCMCSTN,SCMCMNM,SCMCDATE) ;

 +1        NEW %,SCMCNDAT

 +2        KILL ^TMP($JOB,"SCMCQRY")

 +3        KILL RESULT

 +4       ;set variable to name of global array where output data will be stored

           SET RESULT=$NAME(^TMP($JOB,"SCMCQRY"))

 +5       ;initialize to not found

           SET ^TMP($JOB,"SCMCQRY",1)=0

 +6       ;one of the 3 lookup parameters is required

           IF $GET(SCMCLNAM)=""

               IF ($GET(SCMCVPID)="")

                   IF ($GET(SCMCDUZ)="")

                       QUIT

 +7       ;Set to null if missing

           SET SCMCFNAM=$GET(SCMCFNAM)

 +8       ;Set to null if missing

           SET SCMCSSN=$GET(SCMCSSN)

 +9       ;Set to null if missing

           SET SCMCPROV=$GET(SCMCPROV)

 +10      ;Set to null if missing

           SET SCMCSTN=$GET(SCMCSTN)

 +11      ;set to null if missing

           IF $GET(SCMCDATE)=""

               SET SCMCDATE=""

 +12       DO NOW^%DTC

 +13      ;set date to today and truncate time

           SET SCMCNDAT=%\1

 +14      ;change date from hl7 format to fileman format

           SET SCMCDATE=$SELECT(SCMCDATE="":SCMCNDAT,1:$$FMDATE^HLFNC(SCMCDATE))

 +15      ;

 +16      ;initialize new set of variables

           NEW SCMCCNT,SCMCNAME,SCMCIEN,SCMCDOB,SCMCSEX,SCMCPC,SCMCX12,SCMCPASS

 +17      ;set to default ; *811 - setting default to all results (parameter no longer used)

           if $GET(SCMCMNM)=""

               SET SCMCMNM="*"

 +18      ;Initialize variable

           SET SCMCCNT=0

 +19      ;

 +20      ;Lookup by VPID

 +21       IF $GET(SCMCVPID)'=""

               Begin DoDot:1

 +22               SET SCMCIEN=$$IEN^XUPS(SCMCVPID)

 +23               IF +SCMCIEN>0

                       Begin DoDot:2

 +24                       DO FILTER

 +25                       if SCMCPASS=0

                               QUIT

 +26                       SET SCMCCNT=SCMCCNT+1

 +27      ;set array with person data

                           DO FOUND(SCMCCNT,SCMCIEN,SCMCDATE)

                       End DoDot:2

               End DoDot:1

               QUIT

 +28      ;

 +29      ;Lookup by DUZ

 +30       IF $GET(SCMCDUZ)'=""

               Begin DoDot:1

 +31               if $$GET1^DIQ(200,SCMCDUZ_",",.01,"I")=""

                       QUIT

 +32               SET SCMCIEN=SCMCDUZ

 +33               DO FILTER

 +34               if SCMCPASS=0

                       QUIT

 +35               SET SCMCCNT=SCMCCNT+1

 +36      ;set array with person data

                   DO FOUND(SCMCCNT,SCMCIEN,SCMCDATE)

               End DoDot:1

               QUIT

 +37      ;

 +38      ;Lookup by name

 +39      ;initialize variables

           SET SCMCIEN=0

           SET SCMCNAME=SCMCLNAM

 +40       NEW SCMCRET,SCMCMSG,SCI

 +41      ;* 811 - modifying to return all results "*" (was 500)

           DO FIND^DIC(200,,"@;.01","PQ",SCMCLNAM,"*","B",,,"SCMCRET","SCMCMSG")

 +42       SET SCI=0

 +43       FOR

               SET SCI=$ORDER(SCMCRET("DILIST",SCI))

               if SCI=""

                   QUIT

               Begin DoDot:1

 +44               SET SCMCIEN=$PIECE(SCMCRET("DILIST",SCI,0),U,1)

 +45               DO FILTER

 +46               if SCMCPASS=0

                       QUIT

 +47               SET SCMCCNT=SCMCCNT+1

 +48      ;set array with person data

                   DO FOUND(SCMCCNT,SCMCIEN,SCMCDATE)

               End DoDot:1

 +49       QUIT

 +50      ;

FILTER    ;

 +1       ;initialize found flag to found

           SET SCMCPASS=1

 +2       ;check if matches name filter

           IF SCMCFNAM]""

               SET SCMCPASS=$$NMATCH(SCMCIEN,SCMCFNAM)

 +3       ;failed to match

           if 'SCMCPASS

               QUIT

 +4       ;check ssn filter

           IF SCMCSSN]""

               IF ($$GET1^DIQ(200,SCMCIEN_",",9)'=SCMCSSN)

                   SET SCMCPASS=0

                   QUIT

 +5       ;possible future use

 +6       ;I SCMCSTN]"" S SCMCPASS=$$STNMAT(SCMCIEN,SCMCSTN) ;check station number

 +7       ;Q:'SCMCPASS  ;failed match

 +8       ;check if active person class

           IF SCMCPROV]""

               IF ($$GET^XUA4A72(SCMCIEN,SCMCDATE)<0)

                   SET SCMCPASS=0

                   QUIT

 +9        QUIT

 +10      ;

FOUND(SCMCCNT,SCMCIEN,SCMCDATE) ;format output array

 +1        NEW SCMCNAME,SCMCSSN,SCMCVPID,SCMCSEX,SCMCDOB,SCMCPHON,SCMCPAGR,I,Y

 +2       ;get full name

           SET Y=$$GET1^DIQ(200,SCMCIEN_",",.01)

 +3       ;format name into last name~first name~middle name

           SET SCMCNAME=$$HLNAME^HLFNC(Y,"~|\/")

 +4       ;make sure formatted name has all 3 pieces

           IF $LENGTH(SCMCNAME,"~")<3

               SET $PIECE(SCMCNAME,"~",3)=""

 +5       ;ssn

           SET SCMCSSN=$$GET1^DIQ(200,SCMCIEN_",",9)

 +6       ;vpid

           SET SCMCVPID=$$GET1^DIQ(200,SCMCIEN_",",9000)

 +7       ;sex

           SET SCMCSEX=$$GET1^DIQ(200,SCMCIEN_",",4,"I")

 +8       ;dob fileman format

           SET SCMCDOB=$$GET1^DIQ(200,SCMCIEN_",",5,"I")

 +9       ;format dob to correct hl7 format yyyymmdd

           IF SCMCDOB]""

               SET SCMCDOB=$$HLDATE^HLFNC(SCMCDOB,"DT")

 +10      ;office phone

           SET SCMCPHON=$$GET1^DIQ(200,SCMCIEN_",",.132)

 +11      ;digital pager

           SET SCMCPAGR=$$GET1^DIQ(200,SCMCIEN_",",.138)

 +12      ;set to indicate match found

           SET ^TMP($JOB,"SCMCQRY",1)=1

 +13       SET ^TMP($JOB,"SCMCQRY",SCMCCNT,0)=SCMCVPID_"^"_SCMCIEN_"^"_SCMCNAME_"^"_SCMCSSN_"^"_SCMCDOB_"^"_SCMCSEX_"^"_SCMCPHON_"^"_SCMCPAGR_"^"

 +14      ;get active person class data

           SET SCMCPC=$$GET^XUA4A72(SCMCIEN,SCMCDATE)

 +15      ;no active person class

           if SCMCPC<0

               SET SCMCPC=""

 +16      ;put provider type, provider class, and are of specialization in output array

           FOR I=1:1:3

               SET ^TMP($JOB,"SCMCQRY",SCMCCNT,I)=$PIECE(SCMCPC,"^",(1+I))_"^"

 +17      ;PCMM Web does not use this - 603

           SET SCMCX12=""

 +18      ;put va code, x12 code, specialty code

           SET ^TMP($JOB,"SCMCQRY",SCMCCNT,4)=$PIECE(SCMCPC,"^",7)_"^"_SCMCX12_"^"_$PIECE(SCMCPC,"^",8)_"^"

 +19      ;603

           SET ^TMP($JOB,"SCMCQRY",SCMCCNT,5)=$$ACTIVE^XUSER(SCMCIEN)_"^|"

 +20       QUIT

 +21      ;

NMATCH(SCMCIEN,SCMCFNAM) ;

 +1       ;Match on First Name

 +2       ;Input Parameters:

 +3       ;      SCMCIEN - Internal Entry Number of New Person entry

 +4       ;     SCMCFNAM - Part or all of Person first name

 +5       ;Output:

 +6       ;      SCMCOUT - 1 if name matched, 0 if name did not match

 +7       ;

 +8       ;establish new variables

           NEW SCMCA,SCMCHFN,SCMCFN,SCMCNFN,SCMCOUT

 +9       ;get full name

           SET SCMCFN=$$GET1^DIQ(200,SCMCIEN_",",.01)

 +10      ;change to HL7 format (last name~first name~middle name)

           SET SCMCHFN=$$HLNAME^HLFNC(SCMCFN,"~|\/")

 +11      ;get first name

           SET SCMCNFN=$PIECE(SCMCHFN,"~",2)

 +12      ; match first name to first name passed

           SET SCMCOUT=$SELECT($EXTRACT(SCMCNFN,1,$LENGTH(SCMCFNAM))[SCMCFNAM:1,1:0)

 +13      ;return 1 if name matched, 0 if no match

           QUIT SCMCOUT

 +14      ;

 +15      ;STNMAT(SCMCIEN,SCMCSTN) ;Station Number matching (possible future use)

 +16      ;Input Parameters:

 +17      ;     SCMCIEN - Internal Entry Number of New Person entry

 +18      ;     SCMCSTN - 3-6 character station number to use as screen

 +19      ;               (i.e. 603 or 528A4)

 +20      ;Output:

 +21      ;     SCMCOUT - 1 if station matched, 0 if no station match

 +22      ;

 +23      ; NOTE: If this code is ever used, needs to be tested and subscription to ICR 4055

 +24      ;

 +25      ;NEW SCMCOUT,SCMCRET,SCI,SCHIT

 +26      ;SET SCMCOUT=0

 +27      ;DO DIVGET^XUSRB2(.SCMCRET,SCMCIEN)

 +28      ;IF +SCMCRET(0)'=0 DO

 +29      ;. SET SCHIT=0

 +30      ;. SET SCI=""

 +31      ;. FOR  SET SCI=$ORDER(SCMCRET(SCI)) QUIT:SCI=""!(SCHIT)  DO

 +32      ;. . IF $PIECE(SCMCRET(SCI),U,3)=SCMCSTN DO

 +33      ;. . . SET SCMCOUT=1

 +34      ;. . . SET SCHIT=1

 +35      ;QUIT SCMCOUT  ;return 1 if match, 0 if no match

 +36      ;

SCMCNPER.m