VPSRPC16.m

VPSRPC16  ;BPOIFO/EL,WOIFO/BT - Patient Demographic (continue);07/31/14 13:07

 ;;1.0;VA POINT OF SERVICE (KIOSKS);**4,14,20**;Jul 31, 2014;Build 29

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

 ;

 ; External Reference DBIA#

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

 ; #10035 - ^DPT( references       (Supported)

 ; #2462  - ^DGEN( reference       (Controlled Sub) 

 ; #2056  - DIQ call               (Supported)

 ; #3402  - PTSEC^DGSEC4 call      (Supported)

 ; #3403  - NOTICE^DGSEC4 call     (Supported)

 ; #3812  - GET^DGENA              (Controlled Subs)

 ; #2701  - MPIF001 call           (Supported)

 ; #10061 - VADPT call             (Supported)

 ; #10103 - XLFDT call             (Supported)

 ; #6098  - Read-Only access to ^DGMT(408.31,"C",DFN) and FIELD HARDSHIP (Controlled Sub)

 QUIT

 ;

GETDEM(VPSARR,DFN) ;given DFN, returns the patient demographics, insurance, and up-coming appointments.

 ; OUTPUT

 ;   VPSARR - passed in by reference; this is the output array to store patient demographics

 ; INPUT

 ;   DFN    - patient DFN (This value must be validated before calling this procedure)

 ;

 D DEM(.VPSARR,DFN) ; Store Patient Demographic Data

 D SENLOG(.VPSARR,DFN) ; Store Patient Sensitive Record File-38.1

 D ELIG(.VPSARR,DFN) ; Store Patient Eligibily

 ;D ENR(.VPSARR,DFN) ; Store Patient Enrollment

 N X,Y

 S X="",X=$O(^DGEN(27.11,"C",DFN,X),-1) Q:$G(X)=""

 S Y="",Y=$$GET1^DIQ(27.11,X_",",.04,"E")

 I $G(Y)'="" D SET(.VPSARR,27.11,DFN,".04",Y)

 D ADD(.VPSARR,DFN) ; Store Patient Address

 D OAD(.VPSARR,DFN) ; Store Other Patient Variables

 D INP(.VPSARR,DFN) ; Inpatient information

 D IBB^VPSRPC26(.VPSARR,DFN) ; Store Patient Insurance Info

 D REC^VPSRPC26(.VPSARR,DFN) ; Store Patient Record Flag

 D DGS^VPSRPC26(.VPSARR,DFN) ; Store Pre-Registration Audit

 D BAL^VPSRPC26(.VPSARR,DFN) ; Store Balance

 ;D OTH^VPSRPC26(.VPSARR,DFN) ; Store Other information not in KNOWN API

 ;D POW^VPSRPC26(.VPSARR,DFN) ; Store POW

 ;D PH^VPSRPC26(.VPSARR,DFN) ; Store Purple Heart

 ;D MP^VPSRPC26(.VPSARR,DFN) ; Store Missing Person

 ;D SVC^VPSRPC26(.VPSARR,DFN) ; Store Service Connected and Rated Disabilities

 ;D CHG^VPSRPC26(.VPSARR,DFN) ; Store Change DT/TM

 ;D BLPAT^VPSRPC26(.VPSARR,DFN) ; Store Billing Patient

 ;D PCT^VPSRPC26(.VPSARR,DFN) ; Primary Care Team

 Q

 ;

DEM(VPSARR,DFN) ; Store Patient Demographic Data

 ; -- Store patient DFN

 D SET(.VPSARR,2,DFN,".001",DFN,"DFN")

 ;

 ; -- Store Patient ICN if exist

 N VPSICN S VPSICN=$$GETICN^MPIF001(DFN)

 N ICN S ICN=VPSICN

 ;Added above line commented out below line after VPS*1.0*20

 ;N ICN S ICN=$P(VPSICN,"V")

 I $G(ICN)'="" D SET(.VPSARR,2,DFN,"991.01",ICN)

 ;

 ; -- Retrieve patient demographics data

 N VADM D DEM^VADPT

 ;

 ; -- Store patient demographics

 N VAL

 S VAL=$G(VADM(1)) D SET(.VPSARR,2,DFN,".01",VAL) ; patient name

 S VAL=$P($G(VADM(2)),U) D SET(.VPSARR,2,DFN,".09",VAL) ; SSN

 S VAL=$P($G(VADM(3)),U) D SET(.VPSARR,2,DFN,".03",VAL) ; DOB - kiosk needs internal (FM) format for all dates

 S VAL=$P($G(VADM(5)),U,2) D SET(.VPSARR,2,DFN,".02",VAL) ; SEX

 S VAL=$P($G(VADM(9)),U,2) D SET(.VPSARR,2,DFN,".08",VAL)

 S VAL=$P($G(VADM(10)),U,2) D SET(.VPSARR,2,DFN,".05",VAL)

 ;

 ; -- Store patient ethnicity

 N SEQ,VPSFL,VPSIEN

 ;

 I $G(VADM(11))'="" D

 . N VPSFL S VPSFL="2.06",SEQ=""

 . F  S SEQ=$O(VADM(11,SEQ)) QUIT:SEQ=""  D

 . . S VAL=$P(VADM(11,SEQ),U,2)

 . . S VPSIEN=DFN_";"_SEQ D SET(.VPSARR,VPSFL,VPSIEN,".01",VAL)

 ;

 ; -- Store patient race

 I $G(VADM(12))'="" D

 . S VPSFL="2.02",SEQ=""

 . F  S SEQ=$O(VADM(12,SEQ)) QUIT:SEQ=""  D

 . . S VAL=$P(VADM(12,SEQ),U,2)

 . . S VPSIEN=DFN_";"_SEQ D SET(.VPSARR,VPSFL,VPSIEN,".01",VAL)

 ;

 QUIT

 ;

SENLOG(VPSARR,DFN) ; Check Patient Sensitive Record File-38.1

 N DGRES

 N VAL S VAL=""

 N DGOPT S DGOPT=U_"VPS KIOSK-PATIENT-SELF-CHECKIN"

 N DGMSG S DGMSG=1

 D PTSEC^DGSEC4(.DGRES,DFN,DGMSG,DGOPT)

 N RES S RES=$G(DGRES(1))

 ;

 I RES=2 D  QUIT

 . N ACTION S ACTION=1

 . D NOTICE^DGSEC4(.DGRES,DFN,DGOPT,ACTION)

 . S VAL="2;SENSITIVE & SEC-AUDIT LOG & KIOSK MACHINE LOGIN-DUZ HOLDING NOSECURITY KEY"

 . D SET(.VPSARR,38.1,DFN,"IA3403",VAL,"SENSITIVE")

 ;

 S:RES=0 VAL="0;NON-SENSITIVE"

 S:RES=1 VAL="1;SENSITIVE & SEC-AUDIT LOG & KIOSK MACHINE LOGIN-DUZ HOLDING SECURITY KEY"

 S:RES=3 VAL="3;CANNOT CHECK SENSITIVE DUE TO KIOSK MACHINE LOGIN-DUZ ACCESSING OWN RECORD"

 S:RES=4 VAL="4;CANNOT CHECK SENSITIVE DUE TO KIOSK MACHINE LOGIN-DUZ MISSING SSN"

 S:VAL="" VAL="-1;MISSING DFN IN SENSITIVE CHECK"

 D SET(.VPSARR,38.1,DFN,"IA3402",VAL,"SENSITIVE")

 ;

 QUIT

 ;

ELIG(VPSARR,DFN) ; Eligibily

 N VAEL D ELIG^VADPT

 N VAL

 S VAL=$P($G(VAEL(6)),U,2) D SET(.VPSARR,2,DFN,391,VAL) ; Patient Type

 S VAL=$$GET1^DIQ(2,DFN_",",.381,"E") D SET(.VPSARR,2,DFN,.381,VAL) ;Eligibility for Medicare

 ;

 ; --- Primary Eligibility Code

 N PELIG S PELIG=$P($G(VAEL(1)),U)

 S VAL=$P($G(VAEL(1)),U,2) D SET(.VPSARR,2,DFN,.361,VAL)

 ;

 S VAL=$P($G(VAEL(5,1)),U) D SET(.VPSARR,2,DFN,.152,VAL) ;InEligible Date

 S VAL=$P($G(VAEL(8)),U,2) D SET(.VPSARR,2,DFN,.3611,VAL) ;Eligibility Status

 S VAL=$$GET1^DIQ(2,DFN_",",.3612,"I") D SET(.VPSARR,2,DFN,.3612,VAL) ; Eligibility Status Date

 S VAL=$P($G(VAEL(9)),U,2) D SET(.VPSARR,2,DFN,.14,VAL) ; Means Test Status

 ;

 ; --- Secondary Eligibility codes

 N ELIG,ELIGNAM S ELIG=0

 F  S ELIG=$O(^DPT("AEL",DFN,ELIG)) Q:'ELIG  D

 . I ELIG'=PELIG S ELIGNAM=$$GET1^DIQ(8,ELIG_",",.01) D SET(.VPSARR,8,DFN_";"_ELIG,.01,ELIGNAM,"SECONDARY ELIGIBILITY CODE")

 ;

 ; --- Annual Mean Test

 N MTIEN S MTIEN=$O(^DGMT(408.31,"C",DFN,0))

 I MTIEN S VAL=$$GET1^DIQ(408.31,MTIEN_",",.2,"E") D SET(.VPSARR,408.31,DFN_";"_MTIEN,.2,VAL) ; HARDSHIP?

 QUIT

 ;

INP(VPSARR,DFN) ;

 N VAIP

 D IN5^VADPT

 D SET(.VPSARR,2,DFN,"",$S(VAIP(5)]"":"YES",1:"NO"),"INPATIENT STATUS") ; Inpatient Status

 D SET(.VPSARR,2,DFN,.1,$P(VAIP(5),U,2),"") ; Patient Ward Location

 D SET(.VPSARR,2,DFN,.101,$P(VAIP(6),U,2),"") ; Patient Bed Assignment

 D SET(.VPSARR,2,DFN,.109,$P(VAIP(19,1),U,2),"") ; Facility Directory Preference

 QUIT

 ;

ENR(VPSARR,DFN) ; Enrollment

 N ENRIEN S ENRIEN=$O(^DGEN(27.11,"C",DFN,""),-1)

 QUIT:ENRIEN=""

 N DGENR D GET^DGENA(ENRIEN,.DGENR)

 N VAL

 S VAL=$G(DGENR("STATUS")),VAL=$$GET1^DIQ(27.11,ENRIEN_",",.04,"E") D SET(.VPSARR,27.11,DFN_";"_ENRIEN,.04,VAL) ;ENROLLMENT STATUS

 S VAL=$G(DGENR("ELIG","CODE")),VAL=$$GET1^DIQ(27.11,ENRIEN_",",50.01,"E") D SET(.VPSARR,27.11,DFN_";"_ENRIEN,50.01,VAL) ;ELIGIBILITY CODE

 S VAL=$G(DGENR("ELIG","SC")) D SET(.VPSARR,27.11,DFN_";"_ENRIEN,50.02,VAL) ;SERVICE CONNECTED

 S VAL=$G(DGENR("ELIG","SCPER")) D SET(.VPSARR,27.11,DFN_";"_ENRIEN,50.03,VAL) ;SERVICE CONNECTED PERCENTAGE

 S VAL=$G(DGENR("DATE")) D SET(.VPSARR,27.11,DFN_";"_ENRIEN,.1,VAL) ;ENROLLMENT DATE

 S VAL=$G(DGENR("EFFDATE")) D SET(.VPSARR,27.11,DFN_";"_ENRIEN,.08,VAL) ;EFFECTIVE DATE

 S VAL=$G(DGENR("PRIORITY")) D SET(.VPSARR,27.11,DFN_";"_ENRIEN,.07,VAL) ;ENROLLMENT PRIORITY

 S VAL=$G(DGENR("ELIG","EC")) D SET(.VPSARR,27.11,DFN_";"_ENRIEN,50.13,VAL) ;SOUTH WEST ASIA CONDITION

 ;

 ; -- Enrollment Clinic

 N ENRCLN,ENRDATE,VAL

 N ECLNSEQ S ECLNSEQ=0

 N EDTSEQ S EDTSEQ=0

 ;

 F  S ECLNSEQ=$O(^DPT(DFN,"DE",ECLNSEQ)) QUIT:'ECLNSEQ  D

 . S ENRCLN=$G(^DPT(DFN,"DE",ECLNSEQ,0)) QUIT:ENRCLN=""

 . S VAL=$$GET1^DIQ(2.001,ECLNSEQ_","_DFN_",",.01,"E") ; enrollment clinic

 . D SET(.VPSARR,2.001,DFN_";"_ECLNSEQ,.01,VAL)

 . N VAL S VAL=$$GET1^DIQ(2.001,ECLNSEQ_","_DFN_",",2,"E") ; current status

 . D SET(.VPSARR,2.001,DFN_";"_ECLNSEQ,2,VAL)

 . ;

 . ; -- Enrollment Data

 . S EDTSEQ=0

 . F  S EDTSEQ=$O(^DPT(DFN,"DE",ECLNSEQ,1,EDTSEQ)) Q:'EDTSEQ  D

 . . S ENRDATE=$G(^DPT(DFN,"DE",ECLNSEQ,1,EDTSEQ,0)) QUIT:ENRDATE=""

 . . S VAL=$$GET1^DIQ(2.011,EDTSEQ_","_ECLNSEQ_","_DFN_",",.01,"I") ; Date of Enrollment

 . . D SET(.VPSARR,2.011,DFN_";"_ECLNSEQ_";"_EDTSEQ,.01,VAL)

 . . S VAL=$$GET1^DIQ(2.011,EDTSEQ_","_ECLNSEQ_","_DFN_",",1,"E") ; opt or ac

 . . D SET(.VPSARR,2.011,DFN_";"_ECLNSEQ_";"_EDTSEQ,1,VAL)

 . . S VAL=$$GET1^DIQ(2.011,EDTSEQ_","_ECLNSEQ_","_DFN_",",2,"E") ; Service

 . . D SET(.VPSARR,2.011,DFN_";"_ECLNSEQ_";"_EDTSEQ,2,VAL)

 . . S VAL=$$GET1^DIQ(2.011,EDTSEQ_","_ECLNSEQ_","_DFN_",",3,"I") ; Date of Discharge

 . . D SET(.VPSARR,2.011,DFN_";"_ECLNSEQ_";"_EDTSEQ,3,VAL)

 . . S VAL=$$GET1^DIQ(2.011,EDTSEQ_","_ECLNSEQ_","_DFN_",",4,"E") ; Reason of Discharge

 . . D SET(.VPSARR,2.011,DFN_";"_ECLNSEQ_";"_EDTSEQ,4,VAL)

 . . S VAL=$$GET1^DIQ(2.011,EDTSEQ_","_ECLNSEQ_","_DFN_",",5,"I") ; Review Date

 . . D SET(.VPSARR,2.011,DFN_";"_ECLNSEQ_";"_EDTSEQ,5,VAL)

 ;

 QUIT

 ;

ADD(VPSARR,DFN) ; Addresses

 N VAPA D ADD^VADPT

 N VAL,TODAY S TODAY=$$DT^XLFDT()

 ;

 S VAL=$P($G(VAPA(9)),U)

 I VAL=""!(TODAY<VAL) D SETPERM(.VPSARR,DFN,.VAPA) QUIT

 ;

 S VAL=$P($G(VAPA(10)),U)

 I VAL=""!(TODAY'>VAL) D SETMP(.VPSARR,DFN,.VAPA) QUIT

 ;

 D SETPERM(.VPSARR,DFN,.VAPA)

 QUIT

 ;

SETPERM(VPSARR,DFN,VAPA) ;  PERM ADDRESS

 N VAL

 S VAL=$G(VAPA(1)) D SET(.VPSARR,2,DFN,".111",VAL)

 S VAL=$G(VAPA(2)) D SET(.VPSARR,2,DFN,".112",VAL)

 S VAL=$G(VAPA(3)) D SET(.VPSARR,2,DFN,".113",VAL)

 S VAL=$G(VAPA(4)) D SET(.VPSARR,2,DFN,".114",VAL)

 S VAL=$P($G(VAPA(5)),U,2) D SET(.VPSARR,2,DFN,".115",VAL)

 S VAL=$P($G(VAPA(7)),U,2) D SET(.VPSARR,2,DFN,".117",VAL)

 S VAL=$G(VAPA(8)) D SET(.VPSARR,2,DFN,".131",VAL)

 S VAL=$P($G(VAPA(11)),U,2) D SET(.VPSARR,2,DFN,".1112",VAL)

 S VAL=$P($G(VAPA(25)),U,2) D SET(.VPSARR,2,DFN,".1173",VAL)

 S VAL=$$GET1^DIQ(2,DFN_",",.1171,"E") D SET(.VPSARR,2,DFN,".1171",VAL)

 S VAL=$$GET1^DIQ(2,DFN_",",.1172,"E") D SET(.VPSARR,2,DFN,".1172",VAL)

 S VAL=$$GET1^DIQ(2,DFN_",",.121,"E") D SET(.VPSARR,2,DFN,".121",VAL)

 S VAL=$$GET1^DIQ(2,DFN_",",.132,"E") D SET(.VPSARR,2,DFN,".132",VAL)

 S VAL=$$GET1^DIQ(2,DFN_",",.134,"E") D SET(.VPSARR,2,DFN,".134",VAL)

 S VAL=$$GET1^DIQ(2,DFN_",",.133,"E") D SET(.VPSARR,2,DFN,".133",VAL)

 D SETCONF(.VPSARR,DFN,.VAPA)

 QUIT

 ;

SETMP(VPSARR,DFN,VAPA) ; SET TEMP ADD

 N VAL

 S VAL=$G(VAPA(1)) D SET(.VPSARR,2,DFN,".1211",VAL)

 S VAL=$G(VAPA(2)) D SET(.VPSARR,2,DFN,".1212",VAL)

 S VAL=$G(VAPA(3)) D SET(.VPSARR,2,DFN,".1213",VAL)

 S VAL=$G(VAPA(4)) D SET(.VPSARR,2,DFN,".1214",VAL)

 S VAL=$P($G(VAPA(5)),U,2) D SET(.VPSARR,2,DFN,".1215",VAL)

 S VAL=$P($G(VAPA(7)),U,2) D SET(.VPSARR,2,DFN,".12111",VAL)

 S VAL=$G(VAPA(8)) D SET(.VPSARR,2,DFN,".1219",VAL)

 S VAL=$P($G(VAPA(9)),U,2) D SET(.VPSARR,2,DFN,".1217",VAL)

 S VAL=$P($G(VAPA(10)),U,2) D SET(.VPSARR,2,DFN,".1218",VAL)

 S VAL=$P($G(VAPA(11)),U,2) D SET(.VPSARR,2,DFN,".12112",VAL)

 S VAL=$P($G(VAPA(25)),U,2) D SET(.VPSARR,2,DFN,".1223",VAL)

 S VAL=$$GET1^DIQ(2,DFN_",",.1221,"E") D SET(.VPSARR,2,DFN,".1221",VAL)

 S VAL=$$GET1^DIQ(2,DFN_",",.1222,"E") D SET(.VPSARR,2,DFN,".1222",VAL)

 ;

 K VAPA S VAPA("P")="" D ADD^VADPT

 D SETPERM(.VPSARR,DFN,.VAPA)

 ;

 QUIT

 ;

SETCONF(VPSARR,DFN,VAPA) ;Confindential address

 N VAL

 S VAL=$G(VAPA(13)) D SET(.VPSARR,2,DFN,".1411",VAL) ; CONFIDENTIAL STREET [LINE 1]

 S VAL=$G(VAPA(14)) D SET(.VPSARR,2,DFN,".1412",VAL) ; CONFIDENTIAL STREET [LINE 2]

 S VAL=$G(VAPA(15)) D SET(.VPSARR,2,DFN,".1413",VAL) ; CONFIDENTIAL STREET [LINE 2]

 S VAL=$G(VAPA(16)) D SET(.VPSARR,2,DFN,".1414",VAL) ; CONFIDENTIAL ADDRESS CITY

 S VAL=$G(VAPA(17)) S VAL=$P(VAL,U,2) D SET(.VPSARR,2,DFN,".1415",VAL) ; CONFIDENTIAL ADDRESS STATE

 S VAL=$G(VAPA(18)) S VAL=$P(VAL,U,2) D SET(.VPSARR,2,DFN,".1416",VAL) ; CONFIDENTIAL ADDRESS ZIP CODE

 S VAL=$G(VAPA(19)) D SET(.VPSARR,2,DFN,".14111",VAL) ; CONFIDENTIAL ADDRESS COUNTY

 S VAL=$G(VAPA(20)) I +VAL D SET(.VPSARR,2,DFN,".1417",+VAL) ; CONFIDENTIAL START DATE

 S VAL=$G(VAPA(21)) I +VAL D SET(.VPSARR,2,DFN,".1418",+VAL) ; CONFIDENTIAL END DATE

 S VAL=$$GET1^DIQ(2,DFN_",",.14105,"E") D SET(.VPSARR,2,DFN,".14105",VAL) ; CONFIDENTIAL ADDRESS ACTIVE?

 S VAL=$P($G(VAPA(28)),U,2) D SET(.VPSARR,2,DFN,".14116",VAL) ; CONFIDENTIAL ADDRESS COUNTRY

 S VAL=$G(VAPA(29)) D SET(.VPSARR,2,DFN,".1315",VAL) ; CONFIDENTIAL PHONE NUMBER

 ;

 ; -- Confidential Address categories

 N TYP S TYP=0

 F  S TYP=$O(VAPA(22,TYP)) Q:'TYP  D

 . S VAL=$P(VAPA(22,TYP),U,2)

 . D SET(.VPSARR,2.141,DFN_";"_TYP,".01",VAL) ; CONFIDENTIAL ADDRESS CATEGORY

 ;

 QUIT

 ;

OAD(VPSARR,DFN) ; Other Patient Variables

 N VAL,VAOA S VAOA("A")=7 D OAD^VADPT    ; NOK

 S VAL=$G(VAOA(1)) D SET(.VPSARR,2,DFN,".213",VAL)

 S VAL=$G(VAOA(2)) D SET(.VPSARR,2,DFN,".214",VAL)

 S VAL=$G(VAOA(3)) D SET(.VPSARR,2,DFN,".215",VAL)

 S VAL=$G(VAOA(4)) D SET(.VPSARR,2,DFN,".216",VAL)

 S VAL=$P(VAOA(5),U,2) D SET(.VPSARR,2,DFN,".217",VAL)

 S VAL=$G(VAOA(11)) S VAL=$P(VAL,U,2) D SET(.VPSARR,2,DFN,".2207",VAL)

 S VAL=$G(VAOA(8)) D SET(.VPSARR,2,DFN,".219",VAL)

 S VAL=$G(VAOA(9)) D SET(.VPSARR,2,DFN,".211",VAL)

 S VAL=$G(VAOA(10)) D SET(.VPSARR,2,DFN,".212",VAL)

 S VAL=$$GET1^DIQ(2,DFN_",",.21011,"E") D SET(.VPSARR,2,DFN,".21011",VAL)

 ;

 K VAOA S VAOA("A")=3 D OAD^VADPT    ; Second NOK

 S VAL=$G(VAOA(1)) D SET(.VPSARR,2,DFN,".2193",VAL)

 S VAL=$G(VAOA(2)) D SET(.VPSARR,2,DFN,".2194",VAL)

 S VAL=$G(VAOA(3)) D SET(.VPSARR,2,DFN,".2195",VAL)

 S VAL=$G(VAOA(4)) D SET(.VPSARR,2,DFN,".2196",VAL)

 S VAL=$P($G(VAOA(5)),U,2) D SET(.VPSARR,2,DFN,".2197",VAL)

 S VAL=$G(VAOA(11)) S VAL=$P(VAL,U,2) D SET(.VPSARR,2,DFN,".2203",VAL)

 S VAL=$G(VAOA(8)) D SET(.VPSARR,2,DFN,".2199",VAL)

 S VAL=$G(VAOA(9)) D SET(.VPSARR,2,DFN,".2191",VAL)

 S VAL=$G(VAOA(10)) D SET(.VPSARR,2,DFN,".2192",VAL)

 S VAL=$$GET1^DIQ(2,DFN_",",.211011,"E") D SET(.VPSARR,2,DFN,".211011",VAL)

 ;

 K VAOA S VAOA("A")=1 D OAD^VADPT    ; Emergency Contact

 S VAL=$G(VAOA(1)) D SET(.VPSARR,2,DFN,".333",VAL)

 S VAL=$G(VAOA(2)) D SET(.VPSARR,2,DFN,".334",VAL)

 S VAL=$G(VAOA(3)) D SET(.VPSARR,2,DFN,".335",VAL)

 S VAL=$G(VAOA(4)) D SET(.VPSARR,2,DFN,".336",VAL)

 S VAL=$P($G(VAOA(5)),U,2) D SET(.VPSARR,2,DFN,".337",VAL)

 S VAL=$P($G(VAOA(11)),U,2) D SET(.VPSARR,2,DFN,".2201",VAL)

 S VAL=$G(VAOA(8)) D SET(.VPSARR,2,DFN,".339",VAL)

 S VAL=$G(VAOA(9)) D SET(.VPSARR,2,DFN,".331",VAL)

 S VAL=$G(VAOA(10)) D SET(.VPSARR,2,DFN,".332",VAL)

 S VAL=$$GET1^DIQ(2,DFN_",",.33011,"E") D SET(.VPSARR,2,DFN,".33011",VAL)

 ;

 K VAOA S VAOA("A")=4 D OAD^VADPT    ; Second Emergency Contact

 S VAL=$G(VAOA(1)) D SET(.VPSARR,2,DFN,".3313",VAL)

 S VAL=$G(VAOA(2)) D SET(.VPSARR,2,DFN,".3314",VAL)

 S VAL=$G(VAOA(3)) D SET(.VPSARR,2,DFN,".3315",VAL)

 S VAL=$G(VAOA(4)) D SET(.VPSARR,2,DFN,".3316",VAL)

 S VAL=$P($G(VAOA(5)),U,2) D SET(.VPSARR,2,DFN,".3317",VAL)

 S VAL=$P($G(VAOA(11)),U,2) D SET(.VPSARR,2,DFN,".2204",VAL)

 S VAL=$G(VAOA(8)) D SET(.VPSARR,2,DFN,".3319",VAL)

 S VAL=$G(VAOA(9)) D SET(.VPSARR,2,DFN,".3311",VAL)

 S VAL=$G(VAOA(10)) D SET(.VPSARR,2,DFN,".3312",VAL)

 S VAL=$$GET1^DIQ(2,DFN_",",.331011,"E") D SET(.VPSARR,2,DFN,".331011",VAL)

 ;

 K VAOA S VAOA("A")=5 D OAD^VADPT    ; Patient Employer

 S VAL=$G(VAOA(8)) D SET(.VPSARR,2,DFN,".3119",VAL)

 S VAL=$G(VAOA(9)) D SET(.VPSARR,2,DFN,".3111",VAL)

 ;

 N VAPD D OPD^VADPT

 S VAL=$P($G(VAPD(7)),U,2) D SET(.VPSARR,2,DFN,".31115",VAL)

 S VAL=$$GET1^DIQ(2,DFN_",",.31116,"E") D SET(.VPSARR,2,DFN,".31116",VAL)

 ;

 K VAOA S VAOA("A")=6 D OAD^VADPT    ; Spouse's Employer

 S VAL=$G(VAOA(8)) D SET(.VPSARR,2,DFN,".258",VAL)

 S VAL=$G(VAOA(9)) D SET(.VPSARR,2,DFN,".251",VAL)

 S VAL=$$GET1^DIQ(2,DFN_",",.2515,"E") D SET(.VPSARR,2,DFN,".2515",VAL)

 S VAL=$$GET1^DIQ(2,DFN_",",.2516,"E") D SET(.VPSARR,2,DFN,".2516",VAL)

 ;

 QUIT

 ;

SET(VPSARR,VPSFL,VPSIEN,VPSFLD,VPSDA,VPSDS) ;Set line item to output array

 I VPSDA'="" D SET^VPSRPC1(.VPSARR,VPSFL,VPSIEN,VPSFLD,VPSDA,$G(VPSDS),6) ;Set line item to output array

 QUIT

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---VPSRPC16   15651     printed  Apr 23, 2025@18:58:01                                                                                                                                                                                                   Page 2

VPSRPC16  ;BPOIFO/EL,WOIFO/BT - Patient Demographic (continue);07/31/14 13:07

 +1       ;;1.0;VA POINT OF SERVICE (KIOSKS);**4,14,20**;Jul 31, 2014;Build 29

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

 +3       ;

 +4       ; External Reference DBIA#

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

 +6       ; #10035 - ^DPT( references       (Supported)

 +7       ; #2462  - ^DGEN( reference       (Controlled Sub) 

 +8       ; #2056  - DIQ call               (Supported)

 +9       ; #3402  - PTSEC^DGSEC4 call      (Supported)

 +10      ; #3403  - NOTICE^DGSEC4 call     (Supported)

 +11      ; #3812  - GET^DGENA              (Controlled Subs)

 +12      ; #2701  - MPIF001 call           (Supported)

 +13      ; #10061 - VADPT call             (Supported)

 +14      ; #10103 - XLFDT call             (Supported)

 +15      ; #6098  - Read-Only access to ^DGMT(408.31,"C",DFN) and FIELD HARDSHIP (Controlled Sub)

 +16       QUIT 

 +17      ;

GETDEM(VPSARR,DFN) ;given DFN, returns the patient demographics, insurance, and up-coming appointments.

 +1       ; OUTPUT

 +2       ;   VPSARR - passed in by reference; this is the output array to store patient demographics

 +3       ; INPUT

 +4       ;   DFN    - patient DFN (This value must be validated before calling this procedure)

 +5       ;

 +6       ; Store Patient Demographic Data

           DO DEM(.VPSARR,DFN)

 +7       ; Store Patient Sensitive Record File-38.1

           DO SENLOG(.VPSARR,DFN)

 +8       ; Store Patient Eligibily

           DO ELIG(.VPSARR,DFN)

 +9       ;D ENR(.VPSARR,DFN) ; Store Patient Enrollment

 +10       NEW X,Y

 +11       SET X=""

           SET X=$ORDER(^DGEN(27.11,"C",DFN,X),-1)

           if $GET(X)=""

               QUIT 

 +12       SET Y=""

           SET Y=$$GET1^DIQ(27.11,X_",",.04,"E")

 +13       IF $GET(Y)'=""

               DO SET(.VPSARR,27.11,DFN,".04",Y)

 +14      ; Store Patient Address

           DO ADD(.VPSARR,DFN)

 +15      ; Store Other Patient Variables

           DO OAD(.VPSARR,DFN)

 +16      ; Inpatient information

           DO INP(.VPSARR,DFN)

 +17      ; Store Patient Insurance Info

           DO IBB^VPSRPC26(.VPSARR,DFN)

 +18      ; Store Patient Record Flag

           DO REC^VPSRPC26(.VPSARR,DFN)

 +19      ; Store Pre-Registration Audit

           DO DGS^VPSRPC26(.VPSARR,DFN)

 +20      ; Store Balance

           DO BAL^VPSRPC26(.VPSARR,DFN)

 +21      ;D OTH^VPSRPC26(.VPSARR,DFN) ; Store Other information not in KNOWN API

 +22      ;D POW^VPSRPC26(.VPSARR,DFN) ; Store POW

 +23      ;D PH^VPSRPC26(.VPSARR,DFN) ; Store Purple Heart

 +24      ;D MP^VPSRPC26(.VPSARR,DFN) ; Store Missing Person

 +25      ;D SVC^VPSRPC26(.VPSARR,DFN) ; Store Service Connected and Rated Disabilities

 +26      ;D CHG^VPSRPC26(.VPSARR,DFN) ; Store Change DT/TM

 +27      ;D BLPAT^VPSRPC26(.VPSARR,DFN) ; Store Billing Patient

 +28      ;D PCT^VPSRPC26(.VPSARR,DFN) ; Primary Care Team

 +29       QUIT 

 +30      ;

DEM(VPSARR,DFN) ; Store Patient Demographic Data

 +1       ; -- Store patient DFN

 +2        DO SET(.VPSARR,2,DFN,".001",DFN,"DFN")

 +3       ;

 +4       ; -- Store Patient ICN if exist

 +5        NEW VPSICN

           SET VPSICN=$$GETICN^MPIF001(DFN)

 +6        NEW ICN

           SET ICN=VPSICN

 +7       ;Added above line commented out below line after VPS*1.0*20

 +8       ;N ICN S ICN=$P(VPSICN,"V")

 +9        IF $GET(ICN)'=""

               DO SET(.VPSARR,2,DFN,"991.01",ICN)

 +10      ;

 +11      ; -- Retrieve patient demographics data

 +12       NEW VADM

           DO DEM^VADPT

 +13      ;

 +14      ; -- Store patient demographics

 +15       NEW VAL

 +16      ; patient name

           SET VAL=$GET(VADM(1))

           DO SET(.VPSARR,2,DFN,".01",VAL)

 +17      ; SSN

           SET VAL=$PIECE($GET(VADM(2)),U)

           DO SET(.VPSARR,2,DFN,".09",VAL)

 +18      ; DOB - kiosk needs internal (FM) format for all dates

           SET VAL=$PIECE($GET(VADM(3)),U)

           DO SET(.VPSARR,2,DFN,".03",VAL)

 +19      ; SEX

           SET VAL=$PIECE($GET(VADM(5)),U,2)

           DO SET(.VPSARR,2,DFN,".02",VAL)

 +20       SET VAL=$PIECE($GET(VADM(9)),U,2)

           DO SET(.VPSARR,2,DFN,".08",VAL)

 +21       SET VAL=$PIECE($GET(VADM(10)),U,2)

           DO SET(.VPSARR,2,DFN,".05",VAL)

 +22      ;

 +23      ; -- Store patient ethnicity

 +24       NEW SEQ,VPSFL,VPSIEN

 +25      ;

 +26       IF $GET(VADM(11))'=""

               Begin DoDot:1

 +27               NEW VPSFL

                   SET VPSFL="2.06"

                   SET SEQ=""

 +28               FOR 

                       SET SEQ=$ORDER(VADM(11,SEQ))

                       if SEQ=""

                           QUIT 

                       Begin DoDot:2

 +29                       SET VAL=$PIECE(VADM(11,SEQ),U,2)

 +30                       SET VPSIEN=DFN_";"_SEQ

                           DO SET(.VPSARR,VPSFL,VPSIEN,".01",VAL)

                       End DoDot:2

               End DoDot:1

 +31      ;

 +32      ; -- Store patient race

 +33       IF $GET(VADM(12))'=""

               Begin DoDot:1

 +34               SET VPSFL="2.02"

                   SET SEQ=""

 +35               FOR 

                       SET SEQ=$ORDER(VADM(12,SEQ))

                       if SEQ=""

                           QUIT 

                       Begin DoDot:2

 +36                       SET VAL=$PIECE(VADM(12,SEQ),U,2)

 +37                       SET VPSIEN=DFN_";"_SEQ

                           DO SET(.VPSARR,VPSFL,VPSIEN,".01",VAL)

                       End DoDot:2

               End DoDot:1

 +38      ;

 +39       QUIT 

 +40      ;

SENLOG(VPSARR,DFN) ; Check Patient Sensitive Record File-38.1

 +1        NEW DGRES

 +2        NEW VAL

           SET VAL=""

 +3        NEW DGOPT

           SET DGOPT=U_"VPS KIOSK-PATIENT-SELF-CHECKIN"

 +4        NEW DGMSG

           SET DGMSG=1

 +5        DO PTSEC^DGSEC4(.DGRES,DFN,DGMSG,DGOPT)

 +6        NEW RES

           SET RES=$GET(DGRES(1))

 +7       ;

 +8        IF RES=2

               Begin DoDot:1

 +9                NEW ACTION

                   SET ACTION=1

 +10               DO NOTICE^DGSEC4(.DGRES,DFN,DGOPT,ACTION)

 +11               SET VAL="2;SENSITIVE & SEC-AUDIT LOG & KIOSK MACHINE LOGIN-DUZ HOLDING NOSECURITY KEY"

 +12               DO SET(.VPSARR,38.1,DFN,"IA3403",VAL,"SENSITIVE")

               End DoDot:1

               QUIT 

 +13      ;

 +14       if RES=0

               SET VAL="0;NON-SENSITIVE"

 +15       if RES=1

               SET VAL="1;SENSITIVE & SEC-AUDIT LOG & KIOSK MACHINE LOGIN-DUZ HOLDING SECURITY KEY"

 +16       if RES=3

               SET VAL="3;CANNOT CHECK SENSITIVE DUE TO KIOSK MACHINE LOGIN-DUZ ACCESSING OWN RECORD"

 +17       if RES=4

               SET VAL="4;CANNOT CHECK SENSITIVE DUE TO KIOSK MACHINE LOGIN-DUZ MISSING SSN"

 +18       if VAL=""