MHVXDEMS ;WAS/GPM/KUM - Secure Messaging Demographics extract ; 12/1/05 6:58pm [3/23/08 8:17pm]
;;1.0;My HealtheVet;**5,9,10**;Aug 23, 2005;Build 50
;;Per VHA Directive 2004-038, this routine should not be modified.
;
Q
;
; Retrieves requested demographics data and returns it in DATAROOT
;
; Integration Agreements:
; 10061 : DEM^VADPT
; : ADD^VADPT
; : ELIG^VADPT
; : OPD^VADPT
; : OAD^VADPT
; : KVAR^VADPT
; 1252 : OUTPTPR^SDUTL3
; 1916 : PRPT^SCAPMC
; 10035 : 2,.1041
; 4459 : 2,.133
;
; Input:
; QRY - Query array
; QRY(DFN) - (required) Pointer to PATIENT (#2) file
; DATAROOT - Root of array to hold extract data
;
; Output:
; DATAROOT - Populated data array
; ERR - Errors during extraction
;
N DFN,X,MHVPCP,MHVERR,EXTIME,VADM,VAPA,VAPD,VAOA
D LOG^MHVUL2("MHVXDEMS","BEGIN","S","TRACE")
S ERR=0
S EXTIME=$$NOW^XLFDT
K @DATAROOT
S DFN=$G(QRY("DFN"))
;
K VADM
D DEM^VADPT
S @DATAROOT@("DOB")=$P($G(VADM(3)),U)
S @DATAROOT@("SEX")=$P($G(VADM(5)),U)
S @DATAROOT@("MARITAL-STATUS")=$P($G(VADM(10)),U,2)
S @DATAROOT@("RELIGION")=$P($G(VADM(9)),U,2)
S @DATAROOT@("DOD")=$P($G(VADM(6)),U)
;
K VAPA
D ADD^VADPT
S @DATAROOT@("ADD1")=$G(VAPA(1))
S @DATAROOT@("ADD2")=$G(VAPA(2))
S @DATAROOT@("ADD3")=$G(VAPA(3))
S @DATAROOT@("CITY")=$G(VAPA(4))
S @DATAROOT@("STATE")=$P($G(VAPA(5)),U,2)
S @DATAROOT@("ZIP")=$P($G(VAPA(11)),U)
S @DATAROOT@("COUNTY")=$P($G(VAPA(7)),U,2)
S @DATAROOT@("PHONE")=$G(VAPA(8))
;
K VAPD
D OPD^VADPT
S @DATAROOT@("BIRTH-CITY")=$G(VAPD(1))
S @DATAROOT@("BIRTH-STATE")=$P($G(VAPD(2)),U,2)
;
K VAOA
S VAOA("A")=5
D OAD^VADPT
S @DATAROOT@("BUS-PHONE")=$G(VAOA(8))
;
S @DATAROOT@("E-MAIL")=$$GET1^DIQ(2,DFN_",",.133)
S @DATAROOT@("ATTENDING-PHYSICIAN")=$$GET1^DIQ(2,DFN_",",.1041)
;
S X=""
;I $$PRPT^SCAPMC(DFN,,,,,,.MHVPCP,.MHVERR) I MHVPCP'="" S X=$P($G(@MHVPCP@(1)),U,2) K @MHVPCP
S X=$$OUTPTPR^SDUTL3(DFN) ;MHV*1*9 always return Primary Care Provider
;I $G(MHVERR)'="" K @MHVERR
S @DATAROOT@("PRIMARY-CARE-PHYSICIAN")=$P(X,"^",2)
;
D KVAR^VADPT
S @DATAROOT=1_"^"_EXTIME
D LOG^MHVUL2("MHVXDEMS","END","S","TRACE")
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMHVXDEMS 2543 printed Dec 13, 2024@02:16:14 Page 2
MHVXDEMS ;WAS/GPM/KUM - Secure Messaging Demographics extract ; 12/1/05 6:58pm [3/23/08 8:17pm]
+1 ;;1.0;My HealtheVet;**5,9,10**;Aug 23, 2005;Build 50
+2 ;;Per VHA Directive 2004-038, this routine should not be modified.
+3 ;
+4 QUIT
+5 ;
+1 ; Retrieves requested demographics data and returns it in DATAROOT
+2 ;
+3 ; Integration Agreements:
+4 ; 10061 : DEM^VADPT
+5 ; : ADD^VADPT
+6 ; : ELIG^VADPT
+7 ; : OPD^VADPT
+8 ; : OAD^VADPT
+9 ; : KVAR^VADPT
+10 ; 1252 : OUTPTPR^SDUTL3
+11 ; 1916 : PRPT^SCAPMC
+12 ; 10035 : 2,.1041
+13 ; 4459 : 2,.133
+14 ;
+15 ; Input:
+16 ; QRY - Query array
+17 ; QRY(DFN) - (required) Pointer to PATIENT (#2) file
+18 ; DATAROOT - Root of array to hold extract data
+19 ;
+20 ; Output:
+21 ; DATAROOT - Populated data array
+22 ; ERR - Errors during extraction
+23 ;
+24 NEW DFN,X,MHVPCP,MHVERR,EXTIME,VADM,VAPA,VAPD,VAOA
+25 DO LOG^MHVUL2("MHVXDEMS","BEGIN","S","TRACE")
+26 SET ERR=0
+27 SET EXTIME=$$NOW^XLFDT
+28 KILL @DATAROOT
+29 SET DFN=$GET(QRY("DFN"))
+30 ;
+31 KILL VADM
+32 DO DEM^VADPT
+33 SET @DATAROOT@("DOB")=$PIECE($GET(VADM(3)),U)
+34 SET @DATAROOT@("SEX")=$PIECE($GET(VADM(5)),U)
+35 SET @DATAROOT@("MARITAL-STATUS")=$PIECE($GET(VADM(10)),U,2)
+36 SET @DATAROOT@("RELIGION")=$PIECE($GET(VADM(9)),U,2)
+37 SET @DATAROOT@("DOD")=$PIECE($GET(VADM(6)),U)
+38 ;
+39 KILL VAPA
+40 DO ADD^VADPT
+41 SET @DATAROOT@("ADD1")=$GET(VAPA(1))
+42 SET @DATAROOT@("ADD2")=$GET(VAPA(2))
+43 SET @DATAROOT@("ADD3")=$GET(VAPA(3))
+44 SET @DATAROOT@("CITY")=$GET(VAPA(4))
+45 SET @DATAROOT@("STATE")=$PIECE($GET(VAPA(5)),U,2)
+46 SET @DATAROOT@("ZIP")=$PIECE($GET(VAPA(11)),U)
+47 SET @DATAROOT@("COUNTY")=$PIECE($GET(VAPA(7)),U,2)
+48 SET @DATAROOT@("PHONE")=$GET(VAPA(8))
+49 ;
+50 KILL VAPD
+51 DO OPD^VADPT
+52 SET @DATAROOT@("BIRTH-CITY")=$GET(VAPD(1))
+53 SET @DATAROOT@("BIRTH-STATE")=$PIECE($GET(VAPD(2)),U,2)
+54 ;
+55 KILL VAOA
+56 SET VAOA("A")=5
+57 DO OAD^VADPT
+58 SET @DATAROOT@("BUS-PHONE")=$GET(VAOA(8))
+59 ;
+60 SET @DATAROOT@("E-MAIL")=$$GET1^DIQ(2,DFN_",",.133)
+61 SET @DATAROOT@("ATTENDING-PHYSICIAN")=$$GET1^DIQ(2,DFN_",",.1041)
+62 ;
+63 SET X=""
+64 ;I $$PRPT^SCAPMC(DFN,,,,,,.MHVPCP,.MHVERR) I MHVPCP'="" S X=$P($G(@MHVPCP@(1)),U,2) K @MHVPCP
+65 ;MHV*1*9 always return Primary Care Provider
SET X=$$OUTPTPR^SDUTL3(DFN)
+66 ;I $G(MHVERR)'="" K @MHVERR
+67 SET @DATAROOT@("PRIMARY-CARE-PHYSICIAN")=$PIECE(X,"^",2)
+68 ;
+69 DO KVAR^VADPT
+70 SET @DATAROOT=1_"^"_EXTIME
+71 DO LOG^MHVUL2("MHVXDEMS","END","S","TRACE")
+72 QUIT
+73 ;
