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 ---[H[J[2J[HVPSRPC21 10675 printed Apr 09, 2024@21:46:04 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
