VAFCPTAD ; ISA/RJS,Zoltan;BIR/PTD - ADD NEW PATIENT ENTRY ;APR 6, 1999
;;5.3;PIMS;**149,1016**;JUN 30, 2012;Build 20
;
ADD(RETURN,PARAM) ;Add an entry to the PATIENT (#2) file for VOA
;
;Input
; PARAM = List of data to be used for the creation of a VistA
; PATIENT (#2) record at the Preferred Facility.
;
;Required elements include:
; PARAM("PRFCLTY")=PREFERRED FACILITY
; PARAM("NAME")=NAME (last name minimal; recommend full name)
; PARAM("GENDER")=SEX
; PARAM("DOB")=DATE OF BIRTH
; PARAM("SSN")=SOCIAL SECURITY NUMBER OR NULL IF NONE
; PARAM("SRVCNCTD")=SERVICE CONNECTED?
; PARAM("TYPE")=TYPE
; PARAM("VET")=VETERAN (Y/N)?
; PARAM("FULLICN")=INTEGRATION CONTROL NUMBER AND CHECKSUM
;
;Optional elements include:
; PARAM("POBCTY")=PLACE OF BIRTH [CITY]
; PARAM("POBST")=PLACE OF BIRTH [STATE]
; PARAM("MMN")=MOTHER'S MAIDEN NAME
; PARAM("ALIAS",#)=ALIAS NAME(last^first^middle^suffix)^ALIAS SSN
;
;Output:
; On Failure: -1^error text - record add failed
; On Success: 1^DFN of new PATIENT (#2) record
;
EN1 ;Check value of all required fields
N ALSERR,DIERR,DPTIDS,DPTX,ERROR,FLG,FDA,FN,LN,MN,RESULT,RGRSICN,SFX,VAL,VAFCA08,X,Y
N VAFCDFN,VAFCDOB,VAFCICN,VAFCMMN,VAFCNAM,VAFCPF,VAFCPOBC,VAFCPOBS
N VAFCRSN,VAFCSRV,VAFCSSN,VAFCSUM,VAFCSX,VAFCTYP,VAFCVET
K RETURN
S (RGRSICN,VAFCA08)=1 S FLG=0 ;allow update to ICN; prevent triggering of messages
;
;PREFERRED FACILITY
I $G(PARAM("PRFCLTY"))="" S RETURN(1)="-1^PREFERRED FACILITY is a required field." Q
I $G(PARAM("PRFCLTY"))'=$P($$SITE^VASITE(),"^",3) S RETURN(1)="-1^PREFERRED FACILITY is not the station to which the RPC was sent." Q
I $G(PARAM("PRFCLTY"))'="" S VAL=$G(PARAM("PRFCLTY")) D CHK^DIE(2,27.02,,VAL,.RESULT) I RESULT="^" S RETURN(1)="-1^"_^TMP("DIERR",$J,1,"TEXT",1) Q
S VAFCPF=VAL,FLG=1
;
;INTEGRATION CONTROL NUMBER and ICN CHECKSUM
I $G(PARAM("FULLICN"))="" S RETURN(1)="-1^Full INTEGRATION CONTROL NUMBER with ICN CHECKSUM is required." Q
I $G(PARAM("FULLICN"))'["V" S RETURN(1)="-1^Full INTEGRATION CONTROL NUMBER with ICN CHECKSUM is required." Q
I $G(PARAM("FULLICN"))'="" D
.S PARAM("ICN")=$P(PARAM("FULLICN"),"V")
.S PARAM("CHKSUM")=$P(PARAM("FULLICN"),"V",2)
I $G(PARAM("ICN"))'="" S VAL=$G(PARAM("ICN")) D CHK^DIE(2,991.01,,VAL,.RESULT) I RESULT="^" S RETURN(1)="-1^"_^TMP("DIERR",$J,1,"TEXT",1) Q
S VAFCICN=VAL,FLG=1
I $G(PARAM("CHKSUM"))'="" S VAL=$G(PARAM("CHKSUM")) D CHK^DIE(2,991.02,,VAL,.RESULT) I RESULT="^" S RETURN(1)="-1^"_^TMP("DIERR",$J,1,"TEXT",1) Q
S VAFCSUM=VAL,FLG=1
;Has patient already been created at this facility? If so get DFN and quit.
I $O(^DPT("AICN",PARAM("ICN"),0)) S RETURN(1)="1^"_$O(^DPT("AICN",PARAM("ICN"),0)) Q
;
;NAME INPUT AS:LAST^FIRST^MIDDLE^SUFFIX; MUST BE FORMATTED FOR VISTA INPUT
I $G(PARAM("NAME"))="" S RETURN(1)="-1^Patient NAME is a required field." Q
S LN=$P($G(PARAM("NAME")),"^"),FN=$P($G(PARAM("NAME")),"^",2),MN=$P($G(PARAM("NAME")),"^",3),SFX=$P($G(PARAM("NAME")),"^",4)
S PARAM("NAME")=LN_","
I FN'="" S PARAM("NAME")=PARAM("NAME")_FN
I MN'="" S PARAM("NAME")=PARAM("NAME")_" "_MN
I SFX'="" S PARAM("NAME")=PARAM("NAME")_" "_SFX
I $G(PARAM("NAME"))'="" S VAL=$G(PARAM("NAME")) D CHK^DIE(2,.01,,VAL,.RESULT) I RESULT="^" S RETURN(1)="-1^"_^TMP("DIERR",$J,1,"TEXT",1) Q
S VAFCNAM=VAL,FLG=1
S DPTX=VAL ;variable used by SSN input transform
;
;DATE OF BIRTH
I $G(PARAM("DOB"))="" S RETURN(1)="-1^DATE OF BIRTH is a required field." Q
I $G(PARAM("DOB"))'="" S VAL=$G(PARAM("DOB")) D CHK^DIE(2,.03,,VAL,.RESULT) I RESULT="^" S RETURN(1)="-1^"_^TMP("DIERR",$J,1,"TEXT",1) Q
S VAFCDOB=VAL,FLG=1
S DPTIDS(.03)=RESULT ;variable used by PSEUDO-SSN code
;
;SOCIAL SECURITY NUMBER not equal null; valid 9-digit number
I '$D(PARAM("SSN")) S RETURN(1)="-1^SOCIAL SECURITY NUMBER is a required field. A null value may be sent." Q
I $G(PARAM("SSN"))'="" S VAL=$G(PARAM("SSN")) D CHK^DIE(2,.09,,VAL,.RESULT) I RESULT="^" S RETURN(1)="-1^"_^TMP("DIERR",$J,1,"TEXT",1) Q
I $G(PARAM("SSN"))'="" S VAFCSSN=VAL,FLG=1
I $G(PARAM("SSN"))="" D ;SSN null, set PSEUDO SSN REASON=SSN UNKNOWN/FOLLOW-UP
.S PARAM("SSN")="P" ;PSEUDO SSN
.S PARAM("PSEUDO")="S" ;PSEUDO SSN REASON
.S VAFCSSN=$G(PARAM("SSN")),FLG=1
.;If SSN null, set PSEUDO SSN REASON (#.0906) =SSN UNKNOWN/FOLLOW-UP
.S VAFCRSN=$G(PARAM("PSEUDO")),FLG=1
;
;SEX
I $G(PARAM("GENDER"))="" S RETURN(1)="-1^GENDER is a required field." Q
I $G(PARAM("GENDER"))'="" S VAL=$G(PARAM("GENDER")) D CHK^DIE(2,.02,,VAL,.RESULT) I RESULT="^" S RETURN(1)="-1^"_^TMP("DIERR",$J,1,"TEXT",1) Q
S VAFCSX=VAL,FLG=1
;
;SERVICE CONNECTED?
I $G(PARAM("SRVCNCTD"))="" S RETURN(1)="-1^'SERVICE CONNECTED?' is a required field." Q
;input set to either YES or NO on the MPI before RPC call; skip CHK^DIE
;here as it resulted in error; expected DFN variable which is not yet set.
I $G(PARAM("SRVCNCTD"))'="" S VAFCSRV=$G(PARAM("SRVCNCTD"))
;
;TYPE
I $G(PARAM("TYPE"))="" S RETURN(1)="-1^Patient TYPE is a required field." Q
I $G(PARAM("TYPE"))'="" S VAL=$G(PARAM("TYPE")) D CHK^DIE(2,391,,VAL,.RESULT) I RESULT="^" S RETURN(1)="-1^"_^TMP("DIERR",$J,1,"TEXT",1) Q
S VAFCTYP=VAL,FLG=1
;
;VETERAN Y/N?
I $G(PARAM("VET"))="" S RETURN(1)="-1^'VETERAN Y/N?' is a required field." Q
;input set to either YES or NO on the MPI before RPC call; skip CHK^DIE
;here as it resulted in error; expected DFN variable which is not yet set.
I $G(PARAM("VET"))'="" S VAFCVET=$E($G(PARAM("VET")),1),FLG=1 ;internal format
;
;Optional - POB CITY
I $D(PARAM("POBCTY")) S VAL=$G(PARAM("POBCTY")) D CHK^DIE(2,.092,,VAL,.RESULT) I RESULT="^" S RETURN(1)="-1^"_^TMP("DIERR",$J,1,"TEXT",1) Q
I $D(PARAM("POBCTY")) S VAFCPOBC=VAL,FLG=1
;
;Optional - POB STATE
N STIEN,UNDEF S UNDEF=0
I $D(PARAM("POBST")) D I UNDEF S RETURN(1)="-1^The value passed for PLACE OF BIRTH [STATE], "_PARAM("POBST")_", is not a valid STATE (#5) file entry." Q
.;Convert STATE ABBREVIATION into STATE NAME
.S STIEN=$O(^DIC(5,"C",PARAM("POBST"),0))
.I STIEN="" S UNDEF=1 Q
.I STIEN'="" S PARAM("POBST")=$P($G(^DIC(5,STIEN,0)),"^")
.S VAL=$G(PARAM("POBST"))
.D CHK^DIE(2,.093,,VAL,.RESULT) I RESULT="^" S RETURN(1)="-1^"_^TMP("DIERR",$J,1,"TEXT",1) Q
.S VAFCPOBS=VAL,FLG=1
;
;Optional - MOTHER'S MAIDEN NAME
I $D(PARAM("MMN")) S VAL=$G(PARAM("MMN")) D CHK^DIE(2,.2403,,VAL,.RESULT) I RESULT="^" S RETURN(1)="-1^"_^TMP("DIERR",$J,1,"TEXT",1) Q
I $D(PARAM("MMN")) S VAFCMMN=VAL,FLG=1
;
I FLG=0 S RETURN(1)="-1^Required information is missing; please check input and try again." Q
;Else ok to file entry
FILE ;Call FILE^DICN to add new entry to PATIENT (#2) file
N DA,DIC,DR K DD,DO
S DIC="^DPT(",DIC(0)="FLZ",DLAYGO=2,X=VAFCNAM
S DIC("DR")=".09///"_VAFCSSN_";.03///"_VAFCDOB_";.02///"_VAFCSX_";391///"_VAFCTYP_";1901////"_VAFCVET_";.301///"_VAFCSRV_";991.01///"_VAFCICN_";991.02///"_VAFCSUM_";27.02///"_VAFCPF
I VAFCSSN="P" S DIC("DR")=DIC("DR")_";.0906///"_VAFCRSN
I $G(VAFCPOBC)'="" S DIC("DR")=DIC("DR")_";.092///"_VAFCPOBC
I $G(VAFCPOBS)'="" S DIC("DR")=DIC("DR")_";.093///"_VAFCPOBS
I $G(VAFCMMN)'="" S DIC("DR")=DIC("DR")_";.2403///"_VAFCMMN
L +^DPT(0):10
D FILE^DICN K DA,DIC,DD,DLAYGO,DO,DR
L -^DPT(0)
;If record creation/update fails, return a -1^error text
I $P(Y,U,3)'=1 S RETURN(1)="-1^"_"Attempt to add patient "_VAFCNAM_" to the PATIENT (#2) file at station number "_$P($$SITE^VASITE,"^",3)_" failed." Q
S VAFCDFN=+Y
;
;File ALIAS multiple
I $D(PARAM("ALIAS")) D ALIAS ;If ALIAS data is passed, call ALIAS module
I $G(ALSERR)="" S RETURN(1)="1^"_VAFCDFN ;No errors for ALIAS, return DFN
I $G(ALSERR)'="" S RETURN(1)=ALSERR
Q
;
;
ALIAS ;Optional - Add ALIAS and ALIAS SSN data for entry
;Only occurs for a NEW record; there is no previous ALIAS data
I '$D(PARAM("ALIAS")) Q
;ALIAS input comes in as: LAST^FIRST^MIDDLE^SUFFIX^SSN
N AFN,ALN,AMN,ASFX,ASSN,ERR,FDA,I,LOC,NUM
S (I,NUM)=0 F S NUM=$O(PARAM("ALIAS",NUM)) Q:'NUM D
.S ALN=$P($G(PARAM("ALIAS",NUM)),"^") Q:ALN="" ;Last name minimal input
.S AFN=$P($G(PARAM("ALIAS",NUM)),"^",2)
.S AMN=$P($G(PARAM("ALIAS",NUM)),"^",3)
.S ASFX=$P($G(PARAM("ALIAS",NUM)),"^",4)
.S ASSN=$P($G(PARAM("ALIAS",NUM)),"^",5)
.;Change format for VistA input: LAST,FIRST MIDDLE SUFFIX^SSN
.S LOC(NUM)=ALN_","
.I AFN'="" S LOC(NUM)=LOC(NUM)_AFN
.I AMN'="" S LOC(NUM)=LOC(NUM)_" "_AMN
.I ASFX'="" S LOC(NUM)=LOC(NUM)_" "_ASFX
.S LOC(NUM)=LOC(NUM)_"^"
.I ASSN'="" S LOC(NUM)=LOC(NUM)_ASSN
.;Set FDA nodes
.S I=I+1 ;Unique sequence number for add to ALIAS SUB-FILE (#2.01
.S FDA(2.01,"+"_I_","_VAFCDFN_",",.01)=$P(LOC(NUM),"^") ; (#.01) ALIAS (name)
.I ASSN'="" S FDA(2.01,"+"_I_","_VAFCDFN_",",1)=$P(LOC(NUM),"^",2) ; (#1) ALIAS SSN
;Update ALIAS multiple with new entries
I $D(FDA) D ;We have ALIAS data to add
.S ALSERR=""
.L +^DPT(VAFCDFN):10
.D UPDATE^DIE("E","FDA",,"ERR")
.L -^DPT(VAFCDFN)
.I $D(ERR("DIERR")) S ALSERR="1^"_VAFCDFN_"^Patient "_PARAM("NAME")_" was successfully added at "_$P($$SITE^VASITE,"^",3)_". However, the ALIAS data failed to update. Error message: "_$G(ERR("DIERR","1","TEXT",1)) Q
Q
;
VAFCPTAD ; ISA/RJS,Zoltan;BIR/PTD - ADD NEW PATIENT ENTRY ;APR 6, 1999
+1 ;;5.3;PIMS;**149,1016**;JUN 30, 2012;Build 20
+2 ;
ADD(RETURN,PARAM) ;Add an entry to the PATIENT (#2) file for VOA
+1 ;
+2 ;Input
+3 ; PARAM = List of data to be used for the creation of a VistA
+4 ; PATIENT (#2) record at the Preferred Facility.
+5 ;
+6 ;Required elements include:
+7 ; PARAM("PRFCLTY")=PREFERRED FACILITY
+8 ; PARAM("NAME")=NAME (last name minimal; recommend full name)
+9 ; PARAM("GENDER")=SEX
+10 ; PARAM("DOB")=DATE OF BIRTH
+11 ; PARAM("SSN")=SOCIAL SECURITY NUMBER OR NULL IF NONE
+12 ; PARAM("SRVCNCTD")=SERVICE CONNECTED?
+13 ; PARAM("TYPE")=TYPE
+14 ; PARAM("VET")=VETERAN (Y/N)?
+15 ; PARAM("FULLICN")=INTEGRATION CONTROL NUMBER AND CHECKSUM
+16 ;
+17 ;Optional elements include:
+18 ; PARAM("POBCTY")=PLACE OF BIRTH [CITY]
+19 ; PARAM("POBST")=PLACE OF BIRTH [STATE]
+20 ; PARAM("MMN")=MOTHER'S MAIDEN NAME
+21 ; PARAM("ALIAS",#)=ALIAS NAME(last^first^middle^suffix)^ALIAS SSN
+22 ;
+23 ;Output:
+24 ; On Failure: -1^error text - record add failed
+25 ; On Success: 1^DFN of new PATIENT (#2) record
+26 ;
EN1 ;Check value of all required fields
+1 NEW ALSERR,DIERR,DPTIDS,DPTX,ERROR,FLG,FDA,FN,LN,MN,RESULT,RGRSICN,SFX,VAL,VAFCA08,X,Y
+2 NEW VAFCDFN,VAFCDOB,VAFCICN,VAFCMMN,VAFCNAM,VAFCPF,VAFCPOBC,VAFCPOBS
+3 NEW VAFCRSN,VAFCSRV,VAFCSSN,VAFCSUM,VAFCSX,VAFCTYP,VAFCVET
+4 KILL RETURN
+5 ;allow update to ICN; prevent triggering of messages
SET (RGRSICN,VAFCA08)=1
SET FLG=0
+6 ;
+7 ;PREFERRED FACILITY
+8 IF $GET(PARAM("PRFCLTY"))=""
SET RETURN(1)="-1^PREFERRED FACILITY is a required field."
QUIT
+9 IF $GET(PARAM("PRFCLTY"))'=$PIECE($$SITE^VASITE(),"^",3)
SET RETURN(1)="-1^PREFERRED FACILITY is not the station to which the RPC was sent."
QUIT
+10 IF $GET(PARAM("PRFCLTY"))'=""
SET VAL=$GET(PARAM("PRFCLTY"))
DO CHK^DIE(2,27.02,,VAL,.RESULT)
IF RESULT="^"
SET RETURN(1)="-1^"_^TMP("DIERR",$JOB,1,"TEXT",1)
QUIT
+11 SET VAFCPF=VAL
SET FLG=1
+12 ;
+13 ;INTEGRATION CONTROL NUMBER and ICN CHECKSUM
+14 IF $GET(PARAM("FULLICN"))=""
SET RETURN(1)="-1^Full INTEGRATION CONTROL NUMBER with ICN CHECKSUM is required."
QUIT
+15 IF $GET(PARAM("FULLICN"))'["V"
SET RETURN(1)="-1^Full INTEGRATION CONTROL NUMBER with ICN CHECKSUM is required."
QUIT
+16 IF $GET(PARAM("FULLICN"))'=""
Begin DoDot:1
+17 SET PARAM("ICN")=$PIECE(PARAM("FULLICN"),"V")
+18 SET PARAM("CHKSUM")=$PIECE(PARAM("FULLICN"),"V",2)
End DoDot:1
+19 IF $GET(PARAM("ICN"))'=""
SET VAL=$GET(PARAM("ICN"))
DO CHK^DIE(2,991.01,,VAL,.RESULT)
IF RESULT="^"
SET RETURN(1)="-1^"_^TMP("DIERR",$JOB,1,"TEXT",1)
QUIT
+20 SET VAFCICN=VAL
SET FLG=1
+21 IF $GET(PARAM("CHKSUM"))'=""
SET VAL=$GET(PARAM("CHKSUM"))
DO CHK^DIE(2,991.02,,VAL,.RESULT)
IF RESULT="^"
SET RETURN(1)="-1^"_^TMP("DIERR",$JOB,1,"TEXT",1)
QUIT
+22 SET VAFCSUM=VAL
SET FLG=1
+23 ;Has patient already been created at this facility? If so get DFN and quit.
+24 IF $ORDER(^DPT("AICN",PARAM("ICN"),0))
SET RETURN(1)="1^"_$ORDER(^DPT("AICN",PARAM("ICN"),0))
QUIT
+25 ;
+26 ;NAME INPUT AS:LAST^FIRST^MIDDLE^SUFFIX; MUST BE FORMATTED FOR VISTA INPUT
+27 IF $GET(PARAM("NAME"))=""
SET RETURN(1)="-1^Patient NAME is a required field."
QUIT
+28 SET LN=$PIECE($GET(PARAM("NAME")),"^")
SET FN=$PIECE($GET(PARAM("NAME")),"^",2)
SET MN=$PIECE($GET(PARAM("NAME")),"^",3)
SET SFX=$PIECE($GET(PARAM("NAME")),"^",4)
+29 SET PARAM("NAME")=LN_","
+30 IF FN'=""
SET PARAM("NAME")=PARAM("NAME")_FN
+31 IF MN'=""
SET PARAM("NAME")=PARAM("NAME")_" "_MN
+32 IF SFX'=""
SET PARAM("NAME")=PARAM("NAME")_" "_SFX
+33 IF $GET(PARAM("NAME"))'=""
SET VAL=$GET(PARAM("NAME"))
DO CHK^DIE(2,.01,,VAL,.RESULT)
IF RESULT="^"
SET RETURN(1)="-1^"_^TMP("DIERR",$JOB,1,"TEXT",1)
QUIT
+34 SET VAFCNAM=VAL
SET FLG=1
+35 ;variable used by SSN input transform
SET DPTX=VAL
+36 ;
+37 ;DATE OF BIRTH
+38 IF $GET(PARAM("DOB"))=""
SET RETURN(1)="-1^DATE OF BIRTH is a required field."
QUIT
+39 IF $GET(PARAM("DOB"))'=""
SET VAL=$GET(PARAM("DOB"))
DO CHK^DIE(2,.03,,VAL,.RESULT)
IF RESULT="^"
SET RETURN(1)="-1^"_^TMP("DIERR",$JOB,1,"TEXT",1)
QUIT
+40 SET VAFCDOB=VAL
SET FLG=1
+41 ;variable used by PSEUDO-SSN code
SET DPTIDS(.03)=RESULT
+42 ;
+43 ;SOCIAL SECURITY NUMBER not equal null; valid 9-digit number
+44 IF '$DATA(PARAM("SSN"))
SET RETURN(1)="-1^SOCIAL SECURITY NUMBER is a required field. A null value may be sent."
QUIT
+45 IF $GET(PARAM("SSN"))'=""
SET VAL=$GET(PARAM("SSN"))
DO CHK^DIE(2,.09,,VAL,.RESULT)
IF RESULT="^"
SET RETURN(1)="-1^"_^TMP("DIERR",$JOB,1,"TEXT",1)
QUIT
+46 IF $GET(PARAM("SSN"))'=""
SET VAFCSSN=VAL
SET FLG=1
+47 ;SSN null, set PSEUDO SSN REASON=SSN UNKNOWN/FOLLOW-UP
IF $GET(PARAM("SSN"))=""
Begin DoDot:1
+48 ;PSEUDO SSN
SET PARAM("SSN")="P"
+49 ;PSEUDO SSN REASON
SET PARAM("PSEUDO")="S"
+50 SET VAFCSSN=$GET(PARAM("SSN"))
SET FLG=1
+51 ;If SSN null, set PSEUDO SSN REASON (#.0906) =SSN UNKNOWN/FOLLOW-UP
+52 SET VAFCRSN=$GET(PARAM("PSEUDO"))
SET FLG=1
End DoDot:1
+53 ;
+54 ;SEX
+55 IF $GET(PARAM("GENDER"))=""
SET RETURN(1)="-1^GENDER is a required field."
QUIT
+56 IF $GET(PARAM("GENDER"))'=""
SET VAL=$GET(PARAM("GENDER"))
DO CHK^DIE(2,.02,,VAL,.RESULT)
IF RESULT="^"
SET RETURN(1)="-1^"_^TMP("DIERR",$JOB,1,"TEXT",1)
QUIT
+57 SET VAFCSX=VAL
SET FLG=1
+58 ;
+59 ;SERVICE CONNECTED?
+60 IF $GET(PARAM("SRVCNCTD"))=""
SET RETURN(1)="-1^'SERVICE CONNECTED?' is a required field."
QUIT
+61 ;input set to either YES or NO on the MPI before RPC call; skip CHK^DIE
+62 ;here as it resulted in error; expected DFN variable which is not yet set.
+63 IF $GET(PARAM("SRVCNCTD"))'=""
SET VAFCSRV=$GET(PARAM("SRVCNCTD"))
+64 ;
+65 ;TYPE
+66 IF $GET(PARAM("TYPE"))=""
SET RETURN(1)="-1^Patient TYPE is a required field."
QUIT
+67 IF $GET(PARAM("TYPE"))'=""
SET VAL=$GET(PARAM("TYPE"))
DO CHK^DIE(2,391,,VAL,.RESULT)
IF RESULT="^"
SET RETURN(1)="-1^"_^TMP("DIERR",$JOB,1,"TEXT",1)
QUIT
+68 SET VAFCTYP=VAL
SET FLG=1
+69 ;
+70 ;VETERAN Y/N?
+71 IF $GET(PARAM("VET"))=""
SET RETURN(1)="-1^'VETERAN Y/N?' is a required field."
QUIT
+72 ;input set to either YES or NO on the MPI before RPC call; skip CHK^DIE
+73 ;here as it resulted in error; expected DFN variable which is not yet set.
+74 ;internal format
IF $GET(PARAM("VET"))'=""
SET VAFCVET=$EXTRACT($GET(PARAM("VET")),1)
SET FLG=1
+75 ;
+76 ;Optional - POB CITY
+77 IF $DATA(PARAM("POBCTY"))
SET VAL=$GET(PARAM("POBCTY"))
DO CHK^DIE(2,.092,,VAL,.RESULT)
IF RESULT="^"
SET RETURN(1)="-1^"_^TMP("DIERR",$JOB,1,"TEXT",1)
QUIT
+78 IF $DATA(PARAM("POBCTY"))
SET VAFCPOBC=VAL
SET FLG=1
+79 ;
+80 ;Optional - POB STATE
+81 NEW STIEN,UNDEF
SET UNDEF=0
+82 IF $DATA(PARAM("POBST"))
Begin DoDot:1
+83 ;Convert STATE ABBREVIATION into STATE NAME
+84 SET STIEN=$ORDER(^DIC(5,"C",PARAM("POBST"),0))
+85 IF STIEN=""
SET UNDEF=1
QUIT
+86 IF STIEN'=""
SET PARAM("POBST")=$PIECE($GET(^DIC(5,STIEN,0)),"^")
+87 SET VAL=$GET(PARAM("POBST"))
+88 DO CHK^DIE(2,.093,,VAL,.RESULT)
IF RESULT="^"
SET RETURN(1)="-1^"_^TMP("DIERR",$JOB,1,"TEXT",1)
QUIT
+89 SET VAFCPOBS=VAL
SET FLG=1
End DoDot:1
IF UNDEF
SET RETURN(1)="-1^The value passed for PLACE OF BIRTH [STATE], "_PARAM("POBST")_", is not a valid STATE (#5) file entry."
QUIT
+90 ;
+91 ;Optional - MOTHER'S MAIDEN NAME
+92 IF $DATA(PARAM("MMN"))
SET VAL=$GET(PARAM("MMN"))
DO CHK^DIE(2,.2403,,VAL,.RESULT)
IF RESULT="^"
SET RETURN(1)="-1^"_^TMP("DIERR",$JOB,1,"TEXT",1)
QUIT
+93 IF $DATA(PARAM("MMN"))
SET VAFCMMN=VAL
SET FLG=1
+94 ;
+95 IF FLG=0
SET RETURN(1)="-1^Required information is missing; please check input and try again."
QUIT
+96 ;Else ok to file entry
FILE ;Call FILE^DICN to add new entry to PATIENT (#2) file
+1 NEW DA,DIC,DR
KILL DD,DO
+2 SET DIC="^DPT("
SET DIC(0)="FLZ"
SET DLAYGO=2
SET X=VAFCNAM
+3 SET DIC("DR")=".09///"_VAFCSSN_";.03///"_VAFCDOB_";.02///"_VAFCSX_";391///"_VAFCTYP_";1901////"_VAFCVET_";.301///"_VAFCSRV_";991.01///"_VAFCICN_";991.02///"_VAFCSUM_";27.02///"_VAFCPF
+4 IF VAFCSSN="P"
SET DIC("DR")=DIC("DR")_";.0906///"_VAFCRSN
+5 IF $GET(VAFCPOBC)'=""
SET DIC("DR")=DIC("DR")_";.092///"_VAFCPOBC
+6 IF $GET(VAFCPOBS)'=""
SET DIC("DR")=DIC("DR")_";.093///"_VAFCPOBS
+7 IF $GET(VAFCMMN)'=""
SET DIC("DR")=DIC("DR")_";.2403///"_VAFCMMN
+8 LOCK +^DPT(0):10
+9 DO FILE^DICN
KILL DA,DIC,DD,DLAYGO,DO,DR
+10 LOCK -^DPT(0)
+11 ;If record creation/update fails, return a -1^error text
+12 IF $PIECE(Y,U,3)'=1
SET RETURN(1)="-1^"_"Attempt to add patient "_VAFCNAM_" to the PATIENT (#2) file at station number "_$PIECE($$SITE^VASITE,"^",3)_" failed."
QUIT
+13 SET VAFCDFN=+Y
+14 ;
+15 ;File ALIAS multiple
+16 ;If ALIAS data is passed, call ALIAS module
IF $DATA(PARAM("ALIAS"))
DO ALIAS
+17 ;No errors for ALIAS, return DFN
IF $GET(ALSERR)=""
SET RETURN(1)="1^"_VAFCDFN
+18 IF $GET(ALSERR)'=""
SET RETURN(1)=ALSERR
+19 QUIT
+20 ;
+21 ;
ALIAS ;Optional - Add ALIAS and ALIAS SSN data for entry
+1 ;Only occurs for a NEW record; there is no previous ALIAS data
+2 IF '$DATA(PARAM("ALIAS"))
QUIT
+3 ;ALIAS input comes in as: LAST^FIRST^MIDDLE^SUFFIX^SSN
+4 NEW AFN,ALN,AMN,ASFX,ASSN,ERR,FDA,I,LOC,NUM
+5 SET (I,NUM)=0
FOR
SET NUM=$ORDER(PARAM("ALIAS",NUM))
IF 'NUM
QUIT
Begin DoDot:1
+6 ;Last name minimal input
SET ALN=$PIECE($GET(PARAM("ALIAS",NUM)),"^")
IF ALN=""
QUIT
+7 SET AFN=$PIECE($GET(PARAM("ALIAS",NUM)),"^",2)
+8 SET AMN=$PIECE($GET(PARAM("ALIAS",NUM)),"^",3)
+9 SET ASFX=$PIECE($GET(PARAM("ALIAS",NUM)),"^",4)
+10 SET ASSN=$PIECE($GET(PARAM("ALIAS",NUM)),"^",5)
+11 ;Change format for VistA input: LAST,FIRST MIDDLE SUFFIX^SSN
+12 SET LOC(NUM)=ALN_","
+13 IF AFN'=""
SET LOC(NUM)=LOC(NUM)_AFN
+14 IF AMN'=""
SET LOC(NUM)=LOC(NUM)_" "_AMN
+15 IF ASFX'=""
SET LOC(NUM)=LOC(NUM)_" "_ASFX
+16 SET LOC(NUM)=LOC(NUM)_"^"
+17 IF ASSN'=""
SET LOC(NUM)=LOC(NUM)_ASSN
+18 ;Set FDA nodes
+19 ;Unique sequence number for add to ALIAS SUB-FILE (#2.01
SET I=I+1
+20 ; (#.01) ALIAS (name)
SET FDA(2.01,"+"_I_","_VAFCDFN_",",.01)=$PIECE(LOC(NUM),"^")
+21 ; (#1) ALIAS SSN
IF ASSN'=""
SET FDA(2.01,"+"_I_","_VAFCDFN_",",1)=$PIECE(LOC(NUM),"^",2)
End DoDot:1
+22 ;Update ALIAS multiple with new entries
+23 ;We have ALIAS data to add
IF $DATA(FDA)
Begin DoDot:1
+24 SET ALSERR=""
+25 LOCK +^DPT(VAFCDFN):10
+26 DO UPDATE^DIE("E","FDA",,"ERR")
+27 LOCK -^DPT(VAFCDFN)
+28 IF $DATA(ERR("DIERR"))
SET ALSERR="1^"_VAFCDFN_"^Patient "_PARAM("NAME")_" was successfully added at "_$PIECE($$SITE^VASITE,"^",3)_". However, the ALIAS data failed to update. Error message: "_$GET(ERR("DIERR","1","TEXT",1))
QUIT
End DoDot:1
+29 QUIT
+30 ;
