- 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 Apr 23, 2025@18:30:32 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 ;
