VPSRPC21.m

VPSRPC21  ;;DALOI/KML,WOIFO/BT - Update of Patient Demographics RPC (Continue from VPSRPC2) ;11/20/11 15:30

 ;;1.0;VA POINT OF SERVICE (KIOSKS);**2**;Oct 21, 2011;Build 41

 ;;Per VHA Directive 2004-038, this routine should not be modified.

 ;

 ; External Reference DBIA#

 ; ------------------------

 ; ICR# 3618 - Postal Code and County Code APIs (Supported)

 Q

 ;

ADDRVAL(PTIEN,REC,REQLST,ILST,VRES) ; validate for required fields for address sets

 ; INPUT - all input parameters except PTIEN passed in by reference

 ;   PTIEN  = DFN

 ;   REC    = incremental number assigned to each subscript built in the OUTPUT array

 ;   REQLST = array to be used when validating the required address sets

 ;   ILST   = data passed in by Vecna (VPSLST array)

 ; OUTPUT 

 ;   VRES   = the array to return the results of ADDRESS validation processing.  Exceptions (only) made available as RPC output for client

 ;

 N OK,ER

 ; validate country and zip code for permanent address

 S OK=$$PERMVAL(.REQLST,.ILST,.ER)

 I 'OK D ADDERR(.REC,.VRES,.ER) ;Add errors to the result array

 I 'OK D CLRPERM(.REQLST,.ILST) ; did not pass validation; clear permanet address fields

 ;

 ; validate foreign/temporary address

 S OK=$$TEMPVAL(PTIEN,.REQLST,.ILST,.ER)

 I 'OK D ADDERR(.REC,.VRES,.ER) ;Add errors to the result array

 I 'OK D CLRTEMP(.REQLST,.ILST) ; did not pass validation; clear permanet address fields

 Q

 ;

PERMVAL(REQLST,ILST,ER) ;validate country and zip code for permanent address

 ; INPUT - all input parameters passed in by reference

 ;   REQLST = array to be used when validating the required address sets

 ;   ILST   = data passed in by Vecna (VPSLST array)

 ; OUTPUT

 ;   ER     = array of Error Message or Empty (No error)

 ; RETURN

 ;    1     = success

 ;    0     = failed

 ;

 ; country must exist. The cross reference validation will happen during filing

 K ER

 ; check if Vecna sent permanent address

 N PERM S PERM=0

 N FLD F FLD=.111,.114,.115,.117,.1112,.1173 I $P(REQLST(FLD),U,3)]"" S PERM=1 Q  ;determine if vecna sent permanent address fields

 Q:'PERM 1 ; permanent address fields not sent, no error

 ;

 ; country must exist to update permanent address fields

 N COUNTRY S COUNTRY=$P(REQLST(.1173),U,3) ;Country sent by Vecna

 I COUNTRY="" S ER(1)="COUNTRY is needed for PERMANENT address fields.  Write to Patient record for the ADDRESS fields did not get performed"

 Q:$D(ER) 0

 N USAADDR S USAADDR=(COUNTRY="USA")!(COUNTRY="UNITED STATES")!(COUNTRY?1N.N)

 Q:'USAADDR 1 ; no zip code validation for non US address

 ;

 ; Validate Zip Code. Changing City, County or State must be accompanied by Zip Code

 N ZIP S ZIP=$P(REQLST(.1112),U,3) ;Zip Code sent by Vecna

 I ZIP="" D CLRCCS(.REQLST,.ILST) ;if zip code was not sent, clear city, county, state from processing. This is to guard someone for entering invalid City/County/State

 Q:ZIP="" 1 ; no city,county,state update, no error

 ;

 N XIP D POSTALB^XIPUTIL(ZIP,.XIP) ;IA #3618 (Supported)

 I 'XIP S ER(1)=XIP("ERROR")_".  Write to Patient record for the ADDRESS fields did not get performed" ;can't find zipcode

 Q:'XIP 0

 ;

 ; validate city,county,state,country for the zipcode

 N CITY S CITY=$P(REQLST(.114),U,3)

 N STATE S STATE=$P(REQLST(.115),U,3)

 N COUNTY S COUNTY=$P(REQLST(.117),U,3)

 N EFLG S EFLG=$$GETZIP(CITY,COUNTY,STATE,.XIP,.ZIPIDX) ;get the index of XIP 

 I EFLG=-1 S ER(1)="Invalid STATE for the ZIPCODE of PERMANENT address.  Write to Patient record for the ADDRESS fields did not get performed"

 I EFLG=-2 S ER(1)="Cannot find DEFAULT CITY for the ZIPCODE OF PERMANENT address.  Write to Patient record for the ADDRESS fields did not get performed"

 I EFLG=1 D UPDZIP(ZIPIDX,.XIP,.REQLST,.ILST) ; Change city, county, state, country to match VistA

 ;

 Q '$D(ER)

 ;

GETZIP(CITY,COUNTY,STATE,XIP,ZIPIDX) ;get the index of XIP of permanent address

 ; INPUT

 ;   CITY   = City sent by VecNa

 ;   COUNTY = County sent by VecNa

 ;   STATE  = State sent by VecNa

 ;   XIP    = VistA Zip Code information in array (multiple entries could exist for a zipcode)

 ; OUTPUT

 ;   ZIPIDX = The selected Index of XIP containing the ZIP CODE information

 ; RETURN

 ;    0     = City, State, County, Country have perfect match between Vecna and Vista

 ;    1     = City/County/state/country doesn't match, require update

 ;   -1     = State sent by Vecna doesn't match VistA based on the ZipCode

 ;   -2     = Can't find default city for the zipcode

 ;

 N RET S RET=-2 ; can't find default address

 S ZIPIDX=0

 ;

 ; find the city in the XIP array

 N IDX F IDX=1:1:XIP I $$UP^XLFSTR($P(XIP(IDX,"CITY"),"*"))=$$UP^XLFSTR(CITY) S ZIPIDX=IDX Q

 ;

 ; if city found, use the index of the XIP as the result

 I ZIPIDX D  ; check other address fields

 . I $P(XIP(ZIPIDX,"CITY"),"*")=CITY,XIP(ZIPIDX,"STATE")=STATE,XIP(ZIPIDX,"COUNTY")=COUNTY S RET=0 Q  ;perfect match

 . I STATE]"",$$UP^XLFSTR(XIP(ZIPIDX,"STATE"))'=$$UP^XLFSTR(STATE) S RET=-1 Q  ;error out, state must match

 . S RET=1 ;require update

 ;

 ; if city not found, use the default address

 I 'ZIPIDX D

 . F IDX=1:1:XIP I XIP(IDX,"CITY KEY")=XIP(IDX,"PREFERRED CITY KEY") S ZIPIDX=IDX,RET=1 Q  ;require update

 . I ZIPIDX,STATE]"",$$UP^XLFSTR(XIP(ZIPIDX,"STATE"))'=$$UP^XLFSTR(STATE) S RET=-1 Q  ;error out, state must match

 ;

 Q RET

 ;

UPDZIP(ZIPIDX,XIP,REQLST,ILST) ; Change city, county, state, country of permanent address to match VistA

 ; INPUT

 ;   ZIPIDX = The selected Index of XIP containing the ZIP CODE information

 ;   XIP    = VistA Zip Code information in array (multiple entries could exist for a zipcode)

 ; OUTPUT

 ;   REQLST = array to be used when validating the required address sets - will be updated based on VistA ZIP Code

 ;   ILST   = data passed in by Vecna (VPSLST array) - will be updated based on VistA ZIP Code

 ;

 S $P(REQLST(.114),U,3)=$P(XIP(ZIPIDX,"CITY"),"*")

 S $P(REQLST(.115),U,3)=XIP(ZIPIDX,"STATE")

 S $P(REQLST(.117),U,3)=XIP(ZIPIDX,"COUNTY")

 ;

 N FLD

 F FLD=.114,.115,.117 D

 . N RECNO S RECNO=$P(REQLST(FLD),U)

 . I 'RECNO D

 . . S RECNO=$O(ILST(""),-1)+1

 . . S $P(REQLST(FLD),U)=RECNO

 . S ILST(RECNO)=$P(REQLST(FLD),U,2,3)

 Q

 ;

CLRPERM(REQLST,ILST) ;clear permanent address

 ; INPUT - all input parameters passed in by reference

 ;   REQLST = array to be used when validating the required address sets

 ; OUTPUT 

 ;   ILST   = data passed in by Vecna (VPSLST array) to be cleared so no update will happen

 ;

 N FLD,RECNO

 F FLD=.111,.112,.113,.114,.115,.117,.121,.1171,.1172,.1173,.1112 S RECNO=$P(REQLST(FLD),U) I RECNO]"" K ILST(RECNO) ; remove from input array so they are not processed for filing into patient record

 Q

 ;

CLRCCS(REQLST,ILST) ;clear zipcode, city, state, county from processing

 ; INPUT - all input parameters passed in by reference

 ;   REQLST = array to be used when validating the required address sets

 ; OUTPUT 

 ;   ILST   = data passed in by Vecna (VPSLST array) to be cleared so no update will happen

 ;

 N FLD,RECNO

 F FLD=.1112,.114,.115,.117 S RECNO=$P(REQLST(FLD),U) I RECNO]"" K ILST(RECNO) ; remove from input array so they are not processed for filing into patient record

 Q

 ;

ADDERR(REC,VRES,ER) ;Add error to the result array

 ; INPUT - all input parameters passed in by reference

 ;   ER     = Error Message to be returned to vecna

 ;   REC    = incremental number assigned to each subscript built in the OUTPUT array

 ; OUTPUT 

 ;   VRES   = the array to return the results of ADDRESS validation processing.  Exceptions (only) made available as RPC output for client

 ;

 N IDX S IDX=""

 F  S IDX=$O(ER(IDX)) Q:IDX=""  S REC=REC+1,VRES(REC)="^^99^"_ER(IDX)

 Q

 ;

TEMPVAL(PTIEN,REQLST,ILIST,ER) ; validate temporary address

 ; INPUT - all input parameters except PTIEN passed in by reference

 ;   PTIEN  = DFN

 ;   REQLST = array to be used when validating data

 ;   ILIST  = data passed in by Vecna (VPSLST array)

 ; OUTPUT 

 ;   ER     = array of Error Message or Empty (No error)

 ; RETURN

 ;    1     = success

 ;    0     = failed

 ;

 K ER

 N TEMP S TEMP=0

 ; check if Vecna sent temp address

 N NUM F NUM=.1211,.1214,.1215,.1217,.1218,.12111,.12112,.1223 Q:TEMP  I $P(REQLST(NUM),U,3)]"" S TEMP=1  ;determine if any required temp address fields are sent

 Q:'TEMP 1 ; temporary address fields not sent

 ;

 ; validate country fields

 N COUNTRY S COUNTRY=$P(REQLST(.1223),U,3)

 I COUNTRY="" S ER(1)=$P(REQLST(.1223),U,2)_" is needed for TEMPORARY (USA and FOREIGN) address fields.  Write to Patient record not performed"

 Q:COUNTRY="" 0

 ;

 ; validate temporarty address 

 N USAADDR S USAADDR=(COUNTRY="USA")!(COUNTRY="UNITED STATES")!(COUNTRY?1N.N)

 I USAADDR D USVAL(.REQLST,.ER) ;validate US Address

 I 'USAADDR D NONUSVAL(.REQLST,.ER) ; validate foreign address

 Q:$D(ER) 0

 ;

 ; update TEMPORARY ADDRESS ACTIVE? field to yes when all required TEMPORARY address fields (USA or FOREIGN) are submitted.

 N VPSFDA S VPSFDA(2,PTIEN_",",.12105)="Y"

 D FILE^DIE("","VPSFDA","")

 Q 1

 ;

USVAL(REQLST,ER) ;validate US Address

 ; INPUT - all input parameters except PTIEN passed in by reference

 ;   REQLST = array to be used when validating data

 ; OUTPUT 

 ;   ER     = array of Error Message or Empty (No error)

 ;

 N IDX S IDX=0

 ;

 ; validate required fields

 N FLD

 F FLD=.1211,.1214,.1215,.1217,.1218,.12111,.12112 I $P(REQLST(FLD),U,3)="" D

 . S IDX=IDX+1

 . S ER(IDX)=$P(REQLST(FLD),U,2)_" is needed for TEMPORARY (USA) address fields.  Write to Patient record for TEMPORARY ADDRESS fields did not get performed"

 Q

 ;

NONUSVAL(REQLST,ER) ; validate foreign address

 ; INPUT - all input parameters except PTIEN passed in by reference

 ;   REQLST = array to be used when validating data

 ; OUTPUT 

 ;   ER     = array of Error Message or Empty (No error)

 ;

 N IDX S IDX=0

 ;

 ; validate required fields

 N FLD

 F FLD=.1211,.1214,.1217,.1218 I $P(REQLST(FLD),U,3)="" D

 . S IDX=IDX+1

 . S ER(IDX)=$P(REQLST(FLD),U,2)_" is needed for TEMPORARY (foreign) address fields.  Write to Patient record not performed"

 Q

 ;

CLRTEMP(REQLST,ILST) ;clear temporary address

 ; INPUT - all input parameters passed in by reference

 ;   REQLST = array to be used when validating the required address sets

 ; OUTPUT 

 ;   ILST   = data passed in by Vecna (VPSLST array) to be cleared so no update will happen

 ;

 N FLD,RECNO

 F FLD=.1211,.1212,.1213,.1214,.1215,.1217,.1218,.1219,.1221,.1222,.1223,.12111,.12112 S RECNO=$P(REQLST(FLD),U) I RECNO]"" K ILST(RECNO)  ; remove from input array so they are not processed for filing into patient record

 Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---VPSRPC21   10675     printed  Apr 23, 2025@18:58:02                                                                                                                                                                                                   Page 2

VPSRPC21  ;;DALOI/KML,WOIFO/BT - Update of Patient Demographics RPC (Continue from VPSRPC2) ;11/20/11 15:30

 +1       ;;1.0;VA POINT OF SERVICE (KIOSKS);**2**;Oct 21, 2011;Build 41

 +2       ;;Per VHA Directive 2004-038, this routine should not be modified.

 +3       ;

 +4       ; External Reference DBIA#

 +5       ; ------------------------

 +6       ; ICR# 3618 - Postal Code and County Code APIs (Supported)

 +7        QUIT 

 +8       ;

ADDRVAL(PTIEN,REC,REQLST,ILST,VRES) ; validate for required fields for address sets

 +1       ; INPUT - all input parameters except PTIEN passed in by reference

 +2       ;   PTIEN  = DFN

 +3       ;   REC    = incremental number assigned to each subscript built in the OUTPUT array

 +4       ;   REQLST = array to be used when validating the required address sets

 +5       ;   ILST   = data passed in by Vecna (VPSLST array)

 +6       ; OUTPUT 

 +7       ;   VRES   = the array to return the results of ADDRESS validation processing.  Exceptions (only) made available as RPC output for client

 +8       ;

 +9        NEW OK,ER

 +10      ; validate country and zip code for permanent address

 +11       SET OK=$$PERMVAL(.REQLST,.ILST,.ER)

 +12      ;Add errors to the result array

           IF 'OK

               DO ADDERR(.REC,.VRES,.ER)

 +13      ; did not pass validation; clear permanet address fields

           IF 'OK

               DO CLRPERM(.REQLST,.ILST)

 +14      ;

 +15      ; validate foreign/temporary address

 +16       SET OK=$$TEMPVAL(PTIEN,.REQLST,.ILST,.ER)

 +17      ;Add errors to the result array

           IF 'OK

               DO ADDERR(.REC,.VRES,.ER)

 +18      ; did not pass validation; clear permanet address fields

           IF 'OK

               DO CLRTEMP(.REQLST,.ILST)

 +19       QUIT 

 +20      ;

PERMVAL(REQLST,ILST,ER) ;validate country and zip code for permanent address

 +1       ; INPUT - all input parameters passed in by reference

 +2       ;   REQLST = array to be used when validating the required address sets

 +3       ;   ILST   = data passed in by Vecna (VPSLST array)

 +4       ; OUTPUT

 +5       ;   ER     = array of Error Message or Empty (No error)

 +6       ; RETURN

 +7       ;    1     = success

 +8       ;    0     = failed

 +9       ;

 +10      ; country must exist. The cross reference validation will happen during filing

 +11       KILL ER

 +12      ; check if Vecna sent permanent address

 +13       NEW PERM

           SET PERM=0

 +14      ;determine if vecna sent permanent address fields

           NEW FLD

           FOR FLD=.111,.114,.115,.117,.1112,.1173

               IF $PIECE(REQLST(FLD),U,3)]""

                   SET PERM=1

                   QUIT 

 +15      ; permanent address fields not sent, no error

           if 'PERM

               QUIT 1

 +16      ;

 +17      ; country must exist to update permanent address fields

 +18      ;Country sent by Vecna

           NEW COUNTRY

           SET COUNTRY=$PIECE(REQLST(.1173),U,3)

 +19       IF COUNTRY=""

               SET ER(1)="COUNTRY is needed for PERMANENT address fields.  Write to Patient record for the ADDRESS fields did not get performed"

 +20       if $DATA(ER)

               QUIT 0

 +21       NEW USAADDR

           SET USAADDR=(COUNTRY="USA")!(COUNTRY="UNITED STATES")!(COUNTRY?1N.N)

 +22      ; no zip code validation for non US address

           if 'USAADDR

               QUIT 1

 +23      ;

 +24      ; Validate Zip Code. Changing City, County or State must be accompanied by Zip Code

 +25      ;Zip Code sent by Vecna

           NEW ZIP

           SET ZIP=$PIECE(REQLST(.1112),U,3)

 +26      ;if zip code was not sent, clear city, county, state from processing. This is to guard someone for entering invalid City/County/State

           IF ZIP=""

               DO CLRCCS(.REQLST,.ILST)

 +27      ; no city,county,state update, no error

           if ZIP=""

               QUIT 1

 +28      ;

 +29      ;IA #3618 (Supported)

           NEW XIP

           DO POSTALB^XIPUTIL(ZIP,.XIP)

 +30      ;can't find zipcode

           IF 'XIP

               SET ER(1)=XIP("ERROR")_".  Write to Patient record for the ADDRESS fields did not get performed"

 +31       if 'XIP

               QUIT 0

 +32      ;

 +33      ; validate city,county,state,country for the zipcode

 +34       NEW CITY

           SET CITY=$PIECE(REQLST(.114),U,3)

 +35       NEW STATE

           SET STATE=$PIECE(REQLST(.115),U,3)

 +36       NEW COUNTY

           SET COUNTY=$PIECE(REQLST(.117),U,3)

 +37      ;get the index of XIP 

           NEW EFLG

           SET EFLG=$$GETZIP(CITY,COUNTY,STATE,.XIP,.ZIPIDX)

 +38       IF EFLG=-1

               SET ER(1)="Invalid STATE for the ZIPCODE of PERMANENT address.  Write to Patient record for the ADDRESS fields did not get performed"

 +39       IF EFLG=-2

               SET ER(1)="Cannot find DEFAULT CITY for the ZIPCODE OF PERMANENT address.  Write to Patient record for the ADDRESS fields did not get performed"

 +40      ; Change city, county, state, country to match VistA

           IF EFLG=1

               DO UPDZIP(ZIPIDX,.XIP,.REQLST,.ILST)

 +41      ;

 +42       QUIT '$DATA(ER)

 +43      ;

GETZIP(CITY,COUNTY,STATE,XIP,ZIPIDX) ;get the index of XIP of permanent address

 +1       ; INPUT

 +2       ;   CITY   = City sent by VecNa

 +3       ;   COUNTY = County sent by VecNa

 +4       ;   STATE  = State sent by VecNa

 +5       ;   XIP    = VistA Zip Code information in array (multiple entries could exist for a zipcode)

 +6       ; OUTPUT

 +7       ;   ZIPIDX = The selected Index of XIP containing the ZIP CODE information

 +8       ; RETURN

 +9       ;    0     = City, State, County, Country have perfect match between Vecna and Vista

 +10      ;    1     = City/County/state/country doesn't match, require update

 +11      ;   -1     = State sent by Vecna doesn't match VistA based on the ZipCode

 +12      ;   -2     = Can't find default city for the zipcode

 +13      ;

 +14      ; can't find default address

           NEW RET

           SET RET=-2

 +15       SET ZIPIDX=0

 +16      ;

 +17      ; find the city in the XIP array

 +18       NEW IDX

           FOR IDX=1:1:XIP

               IF $$UP^XLFSTR($PIECE(XIP(IDX,"CITY"),"*"))=$$UP^XLFSTR(CITY)

                   SET ZIPIDX=IDX

                   QUIT 

 +19      ;

 +20      ; if city found, use the index of the XIP as the result

 +21      ; check other address fields

           IF ZIPIDX

               Begin DoDot:1

 +22      ;perfect match

                   IF $PIECE(XIP(ZIPIDX,"CITY"),"*")=CITY

                       IF XIP(ZIPIDX,"STATE")=STATE

                           IF XIP(ZIPIDX,"COUNTY")=COUNTY

                               SET RET=0

                               QUIT 

 +23      ;error out, state must match

                   IF STATE]""

                       IF $$UP^XLFSTR(XIP(ZIPIDX,"STATE"))'=$$UP^XLFSTR(STATE)

                           SET RET=-1

                           QUIT 

 +24      ;require update

                   SET RET=1

               End DoDot:1

 +25      ;

 +26      ; if city not found, use the default address

 +27       IF 'ZIPIDX

               Begin DoDot:1

 +28      ;require update

                   FOR IDX=1:1:XIP

                       IF XIP(IDX,"CITY KEY")=XIP(IDX,"PREFERRED CITY KEY")

                           SET ZIPIDX=IDX

                           SET RET=1

                           QUIT 

 +29      ;error out, state must match

                   IF ZIPIDX

                       IF STATE]""

                           IF $$UP^XLFSTR(XIP(ZIPIDX,"STATE"))'=$$UP^XLFSTR(STATE)

                               SET RET=-1

                               QUIT 

               End DoDot:1

 +30      ;

 +31       QUIT RET

 +32      ;

UPDZIP(ZIPIDX,XIP,REQLST,ILST) ; Change city, county, state, country of permanent address to match VistA

 +1       ; INPUT

 +2       ;   ZIPIDX = The selected Index of XIP containing the ZIP CODE information

 +3       ;   XIP    = VistA Zip Code information in array (multiple entries could exist for a zipcode)

 +4       ; OUTPUT

 +5       ;   REQLST = array to be used when validating the required address sets - will be updated based on VistA ZIP Code

 +6       ;   ILST   = data passed in by Vecna (VPSLST array) - will be updated based on VistA ZIP Code

 +7       ;

 +8        SET $PIECE(REQLST(.114),U,3)=$PIECE(XIP(ZIPIDX,"CITY"),"*")

 +9        SET $PIECE(REQLST(.115),U,3)=XIP(ZIPIDX,"STATE")

 +10       SET $PIECE(REQLST(.117),U,3)=XIP(ZIPIDX,"COUNTY")

 +11      ;

 +12       NEW FLD

 +13       FOR FLD=.114,.115,.117

               Begin DoDot:1

 +14               NEW RECNO

                   SET RECNO=$PIECE(REQLST(FLD),U)

 +15               IF 'RECNO

                       Begin DoDot:2

 +16                       SET RECNO=$ORDER(ILST(""),-1)+1

 +17                       SET $PIECE(REQLST(FLD),U)=RECNO

                       End DoDot:2

 +18               SET ILST(RECNO)=$PIECE(REQLST(FLD),U,2,3)

               End DoDot:1

 +19       QUIT 

 +20      ;

CLRPERM(REQLST,ILST) ;clear permanent address

 +1       ; INPUT - all input parameters passed in by reference

 +2       ;   REQLST = array to be used when validating the required address sets

 +3       ; OUTPUT 

 +4       ;   ILST   = data passed in by Vecna (VPSLST array) to be cleared so no update will happen

 +5       ;

 +6        NEW FLD,RECNO

 +7       ; remove from input array so they are not processed for filing into patient record

           FOR FLD=.111,.112,.113,.114,.115,.117,.121,.1171,.1172,.1173,.1112

               SET RECNO=$PIECE(REQLST(FLD),U)

               IF RECNO]""

                   KILL ILST(RECNO)

 +8        QUIT 

 +9       ;

CLRCCS(REQLST,ILST) ;clear zipcode, city, state, county from processing

 +1       ; INPUT - all input parameters passed in by reference

 +2       ;   REQLST = array to be used when validating the required address sets

 +3       ; OUTPUT 

 +4       ;   ILST   = data passed in by Vecna (VPSLST array) to be cleared so no update will happen

 +5       ;

 +6        NEW FLD,RECNO

 +7       ; remove from input array so they are not processed for filing into patient record

           FOR FLD=.1112,.114,.115,.117

               SET RECNO=$PIECE(REQLST(FLD),U)

               IF RECNO]""

                   KILL ILST(RECNO)

 +8        QUIT 

 +9       ;

ADDERR(REC,VRES,ER) ;Add error to the result array

 +1       ; INPUT - all input parameters passed in by reference

 +2       ;   ER     = Error Message to be returned to vecna

 +3       ;   REC    = incremental number assigned to each subscript built in the OUTPUT array

 +4       ; OUTPUT 

 +5       ;   VRES   = the array to return the results of ADDRESS validation processing.  Exceptions (only) made available as RPC output for client

 +6       ;

 +7        NEW IDX

           SET IDX=""

 +8        FOR 

               SET IDX=$ORDER(ER(IDX))

               if IDX=""

                   QUIT 

               SET REC=REC+1

               SET VRES(REC)="^^99^"_ER(IDX)

 +9        QUIT 

 +10      ;

TEMPVAL(PTIEN,REQLST,ILIST,ER) ; validate temporary address

 +1       ; INPUT - all input parameters except PTIEN passed in by reference

 +2       ;   PTIEN  = DFN

 +3       ;   REQLST = array to be used when validating data

 +4       ;   ILIST  = data passed in by Vecna (VPSLST array)

 +5       ; OUTPUT 

 +6       ;   ER     = array of Error Message or Empty (No error)

 +7       ; RETURN

 +8       ;    1     = success

 +9       ;    0     = failed

 +10      ;

 +11       KILL ER

 +12       NEW TEMP

           SET TEMP=0

 +13      ; check if Vecna sent temp address

 +14      ;determine if any required temp address fields are sent

           NEW NUM

           FOR NUM=.1211,.1214,.1215,.1217,.1218,.12111,.12112,.1223

               if TEMP

                   QUIT 

               IF $PIECE(REQLST(NUM),U,3)]""

                   SET TEMP=1

 +15      ; temporary address fields not sent

           if 'TEMP

               QUIT 1

 +16      ;

 +17      ; validate country fields

 +18       NEW COUNTRY

           SET COUNTRY=$PIECE(REQLST(.1223),U,3)

 +19       IF COUNTRY=""

               SET ER(1)=$PIECE(REQLST(.1223),U,2)_" is needed for TEMPORARY (USA and FOREIGN) address fields.  Write to Patient record not performed"

 +20       if COUNTRY=""

               QUIT 0

 +21      ;

 +22      ; validate temporarty address 

 +23       NEW USAADDR

           SET USAADDR=(COUNTRY="USA")!(COUNTRY="UNITED STATES")!(COUNTRY?1N.N)

 +24      ;validate US Address

           IF USAADDR

               DO USVAL(.REQLST,.ER)

 +25      ; validate foreign address

           IF 'USAADDR

               DO NONUSVAL(.REQLST,.ER)

 +26       if $DATA(ER)

               QUIT 0

 +27      ;

 +28      ; update TEMPORARY ADDRESS ACTIVE? field to yes when all required TEMPORARY address fields (USA or FOREIGN) are submitted.

 +29       NEW VPSFDA

           SET VPSFDA(2,PTIEN_",",.12105)="Y"

 +30       DO FILE^DIE("","VPSFDA","")

 +31       QUIT 1

 +32      ;

USVAL(REQLST,ER) ;validate US Address

 +1       ; INPUT - all input parameters except PTIEN passed in by reference

 +2       ;   REQLST = array to be used when validating data

 +3       ; OUTPUT 

 +4       ;   ER     = array of Error Message or Empty (No error)

 +5       ;

 +6        NEW IDX

           SET IDX=0

 +7       ;

 +8       ; validate required fields

 +9        NEW FLD

 +10       FOR FLD=.1211,.1214,.1215,.1217,.1218,.12111,.12112

               IF $PIECE(REQLST(FLD),U,3)=""

                   Begin DoDot:1

 +11                   SET IDX=IDX+1

 +12                   SET ER(IDX)=$PIECE(REQLST(FLD),U,2)_" is needed for TEMPORARY (USA) address fields.  Write to Patient record for TEMPORARY ADDRESS fields did not get performed"

                   End DoDot:1

 +13       QUIT 

 +14      ;

NONUSVAL(REQLST,ER) ; validate foreign address

 +1       ; INPUT - all input parameters except PTIEN passed in by reference

 +2       ;   REQLST = array to be used when validating data

 +3       ; OUTPUT 

 +4       ;   ER     = array of Error Message or Empty (No error)

 +5       ;

 +6        NEW IDX

           SET IDX=0

 +7       ;

 +8       ; validate required fields

 +9        NEW FLD

 +10       FOR FLD=.1211,.1214,.1217,.1218

               IF $PIECE(REQLST(FLD),U,3)=""

                   Begin DoDot:1

 +11                   SET IDX=IDX+1

 +12                   SET ER(IDX)=$PIECE(REQLST(FLD),U,2)_" is needed for TEMPORARY (foreign) address fields.  Write to Patient record not performed"

                   End DoDot:1

 +13       QUIT 

 +14      ;

CLRTEMP(REQLST,ILST) ;clear temporary address

 +1       ; INPUT - all input parameters passed in by reference

 +2       ;   REQLST = array to be used when validating the required address sets

 +3       ; OUTPUT 

 +4       ;   ILST   = data passed in by Vecna (VPSLST array) to be cleared so no update will happen

 +5       ;

 +6        NEW FLD,RECNO

 +7       ; remove from input array so they are not processed for filing into patient record

           FOR FLD=.1211,.1212,.1213,.1214,.1215,.1217,.1218,.1219,.1221,.1222,.1223,.12111,.12112

               SET RECNO=$PIECE(REQLST(FLD),U)

               IF RECNO]""

                   KILL ILST(RECNO)

 +8        QUIT