Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: VPSRPC26

VPSRPC26.m

Go to the documentation of this file. 
  1. VPSRPC26  ;BPOIFO/EL,SLOIFO/BT - Patient Demographic (continue);07/31/14 13:07
  1.  ;;1.0;VA POINT OF SERVICE (KIOSKS);**4,14**;Jul 31, 2014;Build 26
  1.  ;;Per VHA Directive 2004-038, this routine should not be modified.
  1.  ;
  1.  ; External Reference DBIA#
  1.  ; ------------------------
  1.  ; #2056  - DIQ call              (Supported)
  1.  ; #2701  - MPIF001 call          (Supported)
  1.  ; #3860  - DGPFAPI call          (Controlled Sub)
  1.  ; #4289  - PRCAHV call           (Controlled Sub)
  1.  ; #4419  - IBBAPI call           (Supported)
  1.  ; #4425  - ^DGS( references      (Controlled Sub)
  1.  ; #4462  - $$GETSHAD^DGUTL3      (Supported)
  1.  ; #4499  - $$LST^EASECU          (Controlled Sub)
  1.  ; #4807  - $$RDIS^DGRPDB         (Supported)
  1.  ; #6107  - PCDETAIL^ORWPT1 call  (Controlled Sub)
  1.  ; #10035 - ^DPT( references      (Supported)
  1.  ; #10103 - XLFDT call            (Supported)
  1.  ; #10147 - $$RXST^IBARXEU        (Supported)
  1.  QUIT
  1.  ;
  1. IBB(VPSARR,DFN) ; Insurance Info
  1.  N VPSIBB,VPSIBFLD S VPSIBFLD="1,10,11,13,14,21"
  1.  N VAL S VAL=$$INSUR^IBBAPI(DFN,,"ABR",.VPSIBB,VPSIBFLD)
  1.  QUIT:VAL'>0
  1.  ;
  1.  N VPSFL,VPSIEN
  1.  N SEQ S SEQ=""
  1.  ;
  1.  F  S SEQ=$O(VPSIBB("IBBAPI","INSUR",SEQ)) Q:SEQ=""  D
  1.  . S VPSFL="2.312",VPSIEN=DFN_";"_SEQ
  1.  . ; Insurance Company Name
  1.  . S VAL=$G(VPSIBB("IBBAPI","INSUR",SEQ,1))
  1.  . S VAL=$P(VAL,U,2) D SET(.VPSARR,36,VPSIEN,.01,VAL)
  1.  . ; Policy Effective Date
  1.  . S VAL=$G(VPSIBB("IBBAPI","INSUR",SEQ,10))
  1.  . D SET(.VPSARR,VPSFL,VPSIEN,8,VAL)
  1.  . ; Policy Expiration Date
  1.  . S VAL=$G(VPSIBB("IBBAPI","INSUR",SEQ,11))
  1.  . D SET(.VPSARR,VPSFL,VPSIEN,3,VAL)
  1.  . ; Subscribe Name
  1.  . S VAL=$G(VPSIBB("IBBAPI","INSUR",SEQ,13))
  1.  . D SET(.VPSARR,VPSFL,VPSIEN,17,VAL)
  1.  . ; Subscribe ID
  1.  . S VAL=$G(VPSIBB("IBBAPI","INSUR",SEQ,14))
  1.  . D SET(.VPSARR,VPSFL,VPSIEN,1,VAL)
  1.  ;
  1.  QUIT
  1.  ;
  1. REC(VPSARR,DFN) ; Patient Record Flag
  1.  N PRF,NPRF,PRFFIL,PRFLAG,VAL
  1.  S NPRF=$$GETACT^DGPFAPI(DFN,"VPSREC") ;Retrieve all ACTIVE Patient record flag assignments
  1.  ;
  1.  ; Store all Patient Record Flags and Assigment Narratives into result array (VPSARR)
  1.  F PRF=1:1:NPRF D
  1.  . ;store flag type
  1.  . S VAL=$P(VPSREC(PRF,"FLAGTYPE"),U,2)
  1.  . S PRFLAG=$P(VPSREC(PRF,"FLAG"),U)
  1.  . I VAL'="",PRFLAG'="" D
  1.  . . S PRFFIL=$P($P(PRFLAG,"DGPF(",2),",")
  1.  . . I PRFFIL'="" D SET(.VPSARR,PRFFIL,DFN,".03",VAL,"FLAG TYPE")
  1.  . ;store flag name
  1.  . S VAL=$P(VPSREC(PRF,"FLAG"),U,2) D SET(.VPSARR,"26.13",DFN,".02",VAL)
  1.  . D STNARR(PRF,.VPSREC) ; Store ASSIGNMENT NARRATIVE (word-processing) for this counter
  1.  ;
  1.  QUIT
  1.  ;
  1. STNARR(PRF,VPSREC) ; Store ASSIGNMENT NARRATIVE (word-processing) into result array (VPSARR)
  1.  N VAL,NARRCNT S NARRCNT=""
  1.  F  S NARRCNT=$O(VPSREC(PRF,"NARR",NARRCNT)) Q:NARRCNT=""  D
  1.  . S VAL=$G(VPSREC(PRF,"NARR",NARRCNT,0)) D SET(.VPSARR,"26.132",DFN,".01",VAL)
  1.  QUIT
  1.  ;
  1. DGS(VPSARR,DFN) ; Pre-Registration Audit
  1.  N VPSFL S VPSFL="41.41"
  1.  N DGIEN S DGIEN=$O(^DGS(VPSFL,"ADC",DFN,""),-1)
  1.  D SET(.VPSARR,VPSFL,DFN,1,DGIEN)
  1.  QUIT
  1.  ;
  1. BAL(VPSARR,DFN) ; BALANCE-OWED
  1.  N VPSICN S VPSICN=$$GETICN^MPIF001(DFN)
  1.  N ICN S ICN=$P(VPSICN,"V")
  1.  N VAL,BAL S BAL=$$BALANCE^PRCAHV(.VAL,ICN,"ALL")
  1.  I BAL=1 D SET(.VPSARR,430,DFN,"COMPUTED",VAL,"BALANCE")
  1.  QUIT
  1.  ;
  1. OTH(VPSARR,DFN) ; Other info not in known category
  1.  N VAL
  1.  S VAL=$$GET1^DIQ(2,DFN_",",.323,"E") D SET(.VPSARR,2,DFN,.323,VAL) ;Period of Service
  1.  S VAL=$$GET1^DIQ(2,DFN_",",1100.01,"E") D SET(.VPSARR,2,DFN,1100.01,VAL) ; Fugitive Felon Flag
  1.  S VAL=$$GET1^DIQ(2,DFN_",",.109,"E") D SET(.VPSARR,2,DFN,.109,VAL) ; Exclude From Facility DIRECTORY?
  1.  S VAL=$$GET1^DIQ(2,DFN_",",63,"E") D SET(.VPSARR,2,DFN,63,VAL) ; Laboratory Reference
  1.  S VAL=$$GET1^DIQ(2,DFN_",",.305,"E") D SET(.VPSARR,2,DFN,.305,VAL) ; Unemployable
  1.  QUIT
  1.  ;
  1. POW(VPSARR,DFN) ; POW information
  1.  N VAL
  1.  S VAL=$$GET1^DIQ(2,DFN_",",.525,"E") D SET(.VPSARR,2,DFN,".525",VAL) ; POW Status Indicated?
  1.  S VAL=$$GET1^DIQ(2,DFN_",",.526,"E") D SET(.VPSARR,2,DFN,".526",VAL) ; POW Confinement Location
  1.  S VAL=$$GET1^DIQ(2,DFN_",",.527,"I") D SET(.VPSARR,2,DFN,".527",VAL) ; POW From Date
  1.  S VAL=$$GET1^DIQ(2,DFN_",",.528,"I") D SET(.VPSARR,2,DFN,".528",VAL) ; POW Through Date
  1.  S VAL=$$GET1^DIQ(2,DFN_",",.529,"I") D SET(.VPSARR,2,DFN,".529",VAL) ; POW Status Verified
  1.  QUIT
  1.  ;
  1. PH(VPSARR,DFN) ; Store PURPLE HEART
  1.  N VAL
  1.  S VAL=$$GET1^DIQ(2,DFN_",",.531,"E") D SET(.VPSARR,2,DFN,".531",VAL) ; Current PH Indicator
  1.  S VAL=$$GET1^DIQ(2,DFN_",",.532,"E") D SET(.VPSARR,2,DFN,".532",VAL) ; Current PH Status
  1.  S VAL=$$GET1^DIQ(2,DFN_",",.533,"E") D SET(.VPSARR,2,DFN,".533",VAL) ; Current PH Remarks
  1.  QUIT
  1.  ;
  1. MP(VPSARR,DFN) ; Store Missing Person
  1.  N VAL S VAL=$$GET1^DIQ(2,DFN_",",.153,"I") D SET(.VPSARR,2,DFN,.153,VAL) ; Missing Person Date
  1.  ;
  1.  N WP S WP=$$GET1^DIQ(2,DFN_",",.16,"","WP") ; Missing or ineligible
  1.  N SEQ S SEQ=0 S VAL=""
  1.  F  S SEQ=$O(WP(SEQ)) QUIT:'SEQ  S VAL=VAL_" "_WP(SEQ)
  1.  D SET(.VPSARR,2,DFN,.16,VAL)
  1.  ;
  1.  N INE S INE=$G(^DPT(DFN,"INE"))
  1.  QUIT:INE=""
  1.  S VAL=$P(INE,U,7) D SET(.VPSARR,2,DFN,".1657",VAL) ; Missing Person TWX Source
  1.  S VAL=$P(INE,U,8) D SET(.VPSARR,2,DFN,".1658",VAL) ; Missing Person TWX City
  1.  S VAL=$P(INE,U,9) D SET(.VPSARR,2,DFN,".1659",VAL) ; Missing Person TWX State
  1.  QUIT
  1.  ;
  1. SVC(VPSARR,DFN) ; Store Service Connected and Rated Disabilities
  1.  N VAL
  1.  S VAL=$$GET1^DIQ(2,DFN_",",.3012,"I") D SET(.VPSARR,2,DFN,.3012,VAL) ; SC Award Date
  1.  S VAL=$$GET1^DIQ(2,DFN_",",.3014,"I") D SET(.VPSARR,2,DFN,.3014,VAL) ; Effective Date Combine SC% EVAL
  1.  ;
  1.  N DGARR S VAL=$$RDIS^DGRPDB(DFN,.DGARR)
  1.  N SEQ S SEQ=0
  1.  F  S SEQ=$O(DGARR(SEQ)) QUIT:'SEQ  D
  1.  . S VAL=$P(DGARR(SEQ),U,2) D SET(.VPSARR,2.04,DFN,2,VAL) ; Disability %
  1.  . S VAL=$P(DGARR(SEQ),U,3),VAL=$S(VAL=1:"YES",1:"NO") D SET(.VPSARR,2.04,DFN,3,VAL) ; Service Connected
  1.  . S VAL=$P(DGARR(SEQ),U,4),VAL=$$GETXAFF(VAL) D SET(.VPSARR,2.04,DFN,4,VAL) ; Extremity Affected
  1.  . S VAL=$P(DGARR(SEQ),U,5) D SET(.VPSARR,2.04,DFN,5,VAL) ; Original Effective Date
  1.  . S VAL=$P(DGARR(SEQ),U,6) D SET(.VPSARR,2.04,DFN,6,VAL) ; Current Effective Date
  1.  ;
  1.  ;Flags/Environment Indicators
  1.  S VAL=$$GET1^DIQ(2,DFN_",",.32102,"E") D SET(.VPSARR,2,DFN,.32102,VAL) ; Agent Orange Exposure Indicated
  1.  S VAL=$$GET1^DIQ(2,DFN_",",.32107,"I") D SET(.VPSARR,2,DFN,.32107,VAL) ; Agent Orange Registration Date
  1.  S VAL=$$GET1^DIQ(2,DFN_",",.32109,"I") D SET(.VPSARR,2,DFN,.32109,VAL) ; Agent Orange Examination Date
  1.  S VAL=$$GET1^DIQ(2,DFN_",",.32103,"E") D SET(.VPSARR,2,DFN,.32103,VAL) ; Radiation Exposure Indicated
  1.  S VAL=$$GET1^DIQ(2,DFN_",",.32111,"E") D SET(.VPSARR,2,DFN,.32111,VAL) ; Radiation Registration Date
  1.  S VAL=$$GET1^DIQ(2,DFN_",",.3212,"E") D SET(.VPSARR,2,DFN,.3212,VAL) ; Radiation Exposure Method
  1.  S VAL=$$GETSHAD^DGUTL3(DFN),VAL=$S(VAL=1:"YES",1:"NO") D SET(.VPSARR,2,DFN,.32115,VAL) ; Proj 112/shad
  1.  S VAL=$$GET1^DIQ(2,DFN_",",.5291,"E") D SET(.VPSARR,2,DFN,.5291,VAL) ; Combat Service Indicated
  1.  S VAL=$$GET1^DIQ(2,DFN_",",.5293,"I") D SET(.VPSARR,2,DFN,.5293,VAL) ; Combat from date
  1.  S VAL=$$GET1^DIQ(2,DFN_",",.5294,"I") D SET(.VPSARR,2,DFN,.5294,VAL) ; Combat to Date
  1.  QUIT
  1.  ;
  1. GETXAFF(VAL) ; Get external value of Extremity Affected
  1.  QUIT:VAL="BL" "BOTH LOWER"
  1.  QUIT:VAL="BU" "BOTH UPPER"
  1.  QUIT:VAL="RL" "RIGHT LOWER"
  1.  QUIT:VAL="RU" "RIGHT UPPER"
  1.  QUIT:VAL="LL" "LEFT LOWER"
  1.  QUIT:VAL="LU" "LEFT UPPER"
  1.  QUIT ""
  1.  ;
  1. CHG(VPSARR,DFN) ; Store Change DT/TM fields
  1.  N VAL
  1.  S VAL=$$GET1^DIQ(2,DFN_",",.118,"I") D SET(.VPSARR,2,DFN,".118",VAL) ;Address Change DT/TM
  1.  S VAL=$$GET1^DIQ(2,DFN_",",.12113,"I") D SET(.VPSARR,2,DFN,".12113",VAL) ;Temp Address Change DT/TM
  1.  S VAL=$$GET1^DIQ(2,DFN_",",.14112,"I") D SET(.VPSARR,2,DFN,".14112",VAL) ; CONFIDENTIAL ADDRESS CHANGE DT/TM
  1.  S VAL=$$GET1^DIQ(2,DFN_",",.1312,"I") D SET(.VPSARR,2,DFN,".1312",VAL) ; Pager Number Change DT/TM
  1.  S VAL=$$GET1^DIQ(2,DFN_",",.136,"I") D SET(.VPSARR,2,DFN,".136",VAL) ; Email Address Change DT/TM
  1.  S VAL=$$GET1^DIQ(2,DFN_",",.139,"I") D SET(.VPSARR,2,DFN,".139",VAL) ; CELLULAR NUMBER CHANGE DATE/TIME
  1.  S VAL=$$GET1^DIQ(2,DFN_",",.33012,"I") D SET(.VPSARR,2,DFN,".33012",VAL) ; E-Contact Change DT/TM
  1.  S VAL=$$GET1^DIQ(2,DFN_",",.33112,"I") D SET(.VPSARR,2,DFN,".33112",VAL) ; E2-Contact Change DT/TM
  1.  S VAL=$$GET1^DIQ(2,DFN_",",.3412,"I") D SET(.VPSARR,2,DFN,".3412",VAL) ; Designee Change DT/TM
  1.  S VAL=$$GET1^DIQ(2,DFN_",",.21012,"I") D SET(.VPSARR,2,DFN,".21012",VAL) ; PRIMARY NOK CHANGE DATE/TIME
  1.  S VAL=$$GET1^DIQ(2,DFN_",",.211012,"I") D SET(.VPSARR,2,DFN,".211012",VAL) ; SECONDARY NOK CHANGE DATE/TIME
  1.  QUIT
  1.  ;
  1. BLPAT(VPSARR,DFN) ; Store Billing Patient
  1.  N BP S BP=+$$RXST^IBARXEU(DFN)
  1.  QUIT:BP=-1
  1.  N VAL S VAL=$S(BP=0:"NON-EXEMPT",1:"EXEMPT") D SET(.VPSARR,354,DFN,"RX COPAY",VAL) ; COPAY INCOME EXEMPTION STATUS-
  1.  ;N VAL S VAL=$S(BP=0:"NON-EXEMPT",1:"EXEMPT") D SET(.VPSARR,354,DFN,"COMPUTED",VAL) ; COPAY INCOME EXEMPTION STATUS
  1.  D SET(.VPSARR,408.31,DFN,".03",$P($$LST^EASECU(DFN),U,3)) ;"LTC CO-PAY"
  1.  QUIT
  1.  ;
  1. PCT(VPSARR,DFN) ; Primary Care Team
  1.  N PCTLST D PCDETAIL^ORWPT1(.PCTLST,DFN)
  1.  N REC,FLD,FLDVAL
  1.  N PROVIDER
  1.  N ILST S ILST=0
  1.  ;
  1.  F  S ILST=$O(PCTLST(ILST)) QUIT:'ILST  D
  1.  . S REC=PCTLST(ILST)
  1.  . QUIT:'$F(REC,":")
  1.  . S FLD=$$TRIM^XLFSTR($P(REC,":"))
  1.  . S FLDVAL=$$TRIM^XLFSTR($P(REC,":",2))
  1.  . ;
  1.  . I FLD="Primary Care Team" D SET(.VPSARR,2,DFN,"COMPUTED",FLDVAL,"PRIMARY CARE TEAM NAME")
  1.  . I FLD="Phone" D SET(.VPSARR,2,DFN,"COMPUTED",FLDVAL,"PRIMARY CARE TEAM TELEPHONE NUMBER")
  1.  . ;
  1.  . I FLD="Primary Care Provider" S PROVIDER=1 D SET(.VPSARR,2,DFN,"COMPUTED",FLDVAL,"PRIMARY CARE PROVIDER NAME")
  1.  . I FLD="Analog Pager",$G(PROVIDER)=1 D SET(.VPSARR,2,DFN,"COMPUTED",FLDVAL,"PRIMARY CARE PROVIDER ANALOG PAGER")
  1.  . I FLD="Digital Pager",$G(PROVIDER)=1 D SET(.VPSARR,2,DFN,"COMPUTED",FLDVAL,"PRIMARY CARE PROVIDER DIGITAL PAGER")
  1.  . I FLD="Office Phone",$G(PROVIDER)=1 D SET(.VPSARR,2,DFN,"COMPUTED",FLDVAL,"PRIMARY CARE PROVIDER OFFICE PHONE")
  1.  . ;
  1.  . I FLD="Associate Provider" S PROVIDER=2 D SET(.VPSARR,2,DFN,"COMPUTED",FLDVAL,"PRIMARY CARE ASSOCIATE PROVIDER NAME")
  1.  . I FLD="Analog Pager",$G(PROVIDER)=2 D SET(.VPSARR,2,DFN,"COMPUTED",FLDVAL,"PRIMARY CARE ASSOCIATE PROVIDER ANALOG PAGER")
  1.  . I FLD="Digital Pager",$G(PROVIDER)=2 D SET(.VPSARR,2,DFN,"COMPUTED",FLDVAL,"PRIMARY CARE ASSOCIATE PROVIDER DIGITAL PAGER")
  1.  . I FLD="Office Phone",$G(PROVIDER)=2 D SET(.VPSARR,2,DFN,"COMPUTED",FLDVAL,"PRIMARY CARE ASSOCIATE PROVIDER OFFICE PHONE")
  1.  . ;
  1.  . I FLD="Attending Physician" S PROVIDER=3 D SET(.VPSARR,2,DFN,"COMPUTED",FLDVAL,"PRIMARY CARE ATTENDING PHYSICIAN NAME")
  1.  . I FLD="Analog Pager",$G(PROVIDER)=3 D SET(.VPSARR,2,DFN,"COMPUTED",FLDVAL,"PRIMARY CARE ATTENDING PHYSICIAN ANALOG PAGER")
  1.  . I FLD="Digital Pager",$G(PROVIDER)=3 D SET(.VPSARR,2,DFN,"COMPUTED",FLDVAL,"PRIMARY CARE ATTENDING PHYSICIAN DIGITAL PAGER")
  1.  . I FLD="Office Phone",$G(PROVIDER)=3 D SET(.VPSARR,2,DFN,"COMPUTED",FLDVAL,"PRIMARY CARE ATTENDING PHYSICIAN OFFICE PHONE")
  1.  . ; 
  1.  . I FLD="MH Treatment Team" S PROVIDER=4 D SET(.VPSARR,2,DFN,"COMPUTED",FLDVAL,"PRIMARY CARE MENTAL HEALTH TEAM")
  1.  . I FLD="MH Treatment Coordinator" S PROVIDER=4 D SET(.VPSARR,2,DFN,"COMPUTED",FLDVAL,"PRIMARY CARE MENTAL HEALTH COORDINATOR")
  1.  . I FLD="Analog Pager",$G(PROVIDER)=4 D SET(.VPSARR,2,DFN,"COMPUTED",FLDVAL,"PRIMARY CARE MENTAL HEALTH PROVIDER ANALOG PAGER")
  1.  . I FLD="Digital Pager",$G(PROVIDER)=4 D SET(.VPSARR,2,DFN,"COMPUTED",FLDVAL,"PRIMARY CARE MENTAL HEALTH PROVIDER DIGITAL PAGER")
  1.  . I FLD="Office Phone",$G(PROVIDER)=4 D SET(.VPSARR,2,DFN,"COMPUTED",FLDVAL,"PRIMARY CARE MENTAL HEALTH PROVIDER OFFICE PHONE")
  1.  QUIT
  1.  ;
  1. SET(VPSARR,VPSFL,VPSIEN,VPSFLD,VPSDA,VPSDS) ;Set line item to output array
  1.  I VPSDA'="" D SET^VPSRPC1(.VPSARR,VPSFL,VPSIEN,VPSFLD,VPSDA,$G(VPSDS),6) ;Set line item to output array
  1.  QUIT