MHVXDEMS.m

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

 ;

EXTRACT(QRY,ERR,DATAROOT) ; Entry point to extract demographics data

 ; 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 ---MHVXDEMS   2543     printed  Apr 09, 2024@21:17:55                                                                                                                                                                                                    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       ;

EXTRACT(QRY,ERR,DATAROOT) ; Entry point to extract demographics data

 +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      ;