DGRRPSD2.m

DGRRPSD2 ; ALB/SGG - rtnDGRR PatientServices Demographics Secondary ;09/30/03  ; Compiled December 9, 2003 15:23:28

 ;;5.3;Registration;**557,1015**;Aug 13, 1993;Build 21

 ;

DOC ;<DataSet Name='SecondaryDemographics'

 ;

 ;FROM: ^DGSL(38.1,

 ;3         SECURITY ASSIGNED BY (RP200'), [0;3]

 ;4         DATE/TIME SECURITY ASSIGNED (RD), [0;4]

 ;5         SECURITY SOURCE (F), [0;5]

 ;

 ;FROM: ^DPT(PTID

 ;          RACE INFORMATION (Multiple-2.02), [.02;0]

 ;          .01  RACE INFORMATION (M*P10'X), [0;1]

 ;          .02  METHOD OF COLLECTION (RP10.3'), [0;2]

 ;

 ;.352      DEATH ENTERED BY (P200'), [.35;2]

 ;

 ;6         ETHNICITY INFORMATION (Multiple-2.06), [.06;0]

 ;          .01  ETHNICITY INFORMATION (*P10.2'X), [0;1]

 ;          .02  METHOD OF COLLECTION (RP10.3'), [0;2]

 ;          

 ;Primary Care Provider - Use $$NMPCPR^SCAPMCU2(PTID,DT,1) API to

 ;          retrieve Primary Care Provider.  Call VPID^XUPS API to

 ;          convert DUZ to VPID.                    

 ;

GETPSARY(PSARRAY) ;

 NEW CNT

 SET CNT=$G(CNT)+1,PSARRAY(CNT)="<DataSet Name='SecondaryDemographics'"

 SET CNT=$G(CNT)+1,PSARRAY(CNT)="^SecurityAssignedBy^"_$$SECASGBY()

 SET CNT=$G(CNT)+1,PSARRAY(CNT)="^DateTimeSecurityAssigned^"_$$DTSECASG()

 SET CNT=$G(CNT)+1,PSARRAY(CNT)="^SecuritySource^"_$$SECSOURC()

 SET CNT=$G(CNT)+1,PSARRAY(CNT)="^PrimaryCareProvider^"_$$PCP()

 DO ETHNINFO

 DO RACEINFO

 SET CNT=$G(CNT)+1,PSARRAY(CNT)="</DataSet>"_"^^^1"

 QUIT

 ;

SECASGBY() ;

 NEW DATA

 SET DATA=$P(GLOB(38.1),"^",3)

 IF DATA'="" S DATA=$P($G(^VA(200,DATA,0)),"^",1)

 QUIT DATA

 ;

DTSECASG() ;

 QUIT $P(GLOB(38.1),"^",4)

 ;

SECSOURC() ;

 QUIT $P(GLOB(38.1),"^",5)

 ;

DODENTBY() ;

 NEW DATA

 SET DATA=$P(GLOB(.35),"^",2)

 IF DATA'="" SET DATA=$P($G(^VA(200,DATA,0)),"^",1)

 QUIT DATA

 ;

DODVPID() ;

 ;QUIT "200#ROOT"_$P(GLOB(.35),"^",2)

 QUIT $$VPID^XUPS($P(GLOB(.35),"^",2))

 ;

PCP() ;Primary Care Provider

 ; get the PCP's IEN and convert to VPID (primary care physician)

 ; 

 N PATSPCP,PCPIEN,PCPVPID

 SET PATSPCP=$$NMPCPR^SCAPMCU2(PTID,DT,1)

 SET PCPIEN=$P(PATSPCP,"^",1)

 SET PCPVPID=$$VPID^XUPS(+PCPIEN)

 QUIT PCPVPID

 ;

ETHNINFO ;

 NEW ETHCNT,ROWCNT,ETHNIC,METHOD

 SET ETHCNT=0,ROWCNT=0

 FOR  SET ETHCNT=$O(^DPT(PTID,.06,ETHCNT)) QUIT:(ETHCNT<1)  DO

 .SET ETHNIC=$P($G(^DPT(PTID,.06,ETHCNT,0)),"^",1)

 .SET METHOD=$P($G(^DPT(PTID,.06,ETHCNT,0)),"^",2)

 .IF ETHNIC'="" DO

 ..SET ROWCNT=ROWCNT+1

 ..SET ETHNIC=$P($G(^DIC(10.2,ETHNIC,0)),"^",1)

 ..IF METHOD'="" SET METHOD=$P(^DIC(10.3,METHOD,0),"^",1)

 ..SET CNT=$G(CNT)+1,PSARRAY(CNT)="><Ethnicity Row='"_ROWCNT_"'"

 ..SET CNT=$G(CNT)+1,PSARRAY(CNT)="^Ethnicity^"_ETHNIC_"^^ETHNIC^"_ROWCNT

 ..SET CNT=$G(CNT)+1,PSARRAY(CNT)="^MethodOfCollection^"_METHOD_"^^ETHNIC^"_ROWCNT

 ..SET CNT=$G(CNT)+1,PSARRAY(CNT)="></Ethnicity>"

 IF ROWCNT=0 DO

 .SET CNT=$G(CNT)+1,PSARRAY(CNT)="><Ethnicity Row='1' Ethnicity='' MethodOfCollection=''></Ethnicity>"

 QUIT

 ;

RACEINFO ;

 NEW RACECNT,ROWCNT,RACE,METHOD

 SET RACECNT=0,ROWCNT=0

 FOR  SET RACECNT=$O(^DPT(PTID,.02,RACECNT)) QUIT:(RACECNT<1)  DO

 .SET RACE=$P($G(^DPT(PTID,.02,RACECNT,0)),"^",1)

 .SET METHOD=$P($G(^DPT(PTID,.02,RACECNT,0)),"^",2)

 .IF RACE'="" DO

 ..SET ROWCNT=ROWCNT+1

 ..SET RACE=$P($G(^DIC(10,RACE,0)),"^",1)

 ..IF METHOD'="" SET METHOD=$P(^DIC(10.3,METHOD,0),"^",1)

 ..SET CNT=$G(CNT)+1,PSARRAY(CNT)="<Race Row='"_ROWCNT_"'"

 ..SET CNT=$G(CNT)+1,PSARRAY(CNT)="^Race^"_RACE_"^^RACE^"_ROWCNT

 ..SET CNT=$G(CNT)+1,PSARRAY(CNT)="^MethodOfCollection^"_METHOD_"^^RACE^"_ROWCNT

 ..SET CNT=$G(CNT)+1,PSARRAY(CNT)="></Race>"

 IF ROWCNT=0 DO

 .SET CNT=$G(CNT)+1,PSARRAY(CNT)="<Race Row='1' Race='' MethodOfCollection=''></Race>"

 QUIT

DGRRPSD2  ; ALB/SGG - rtnDGRR PatientServices Demographics Secondary ;09/30/03  ; Compiled December 9, 2003 15:23:28

 +1       ;;5.3;Registration;**557,1015**;Aug 13, 1993;Build 21

 +2       ;

DOC       ;<DataSet Name='SecondaryDemographics'

 +1       ;

 +2       ;FROM: ^DGSL(38.1,

 +3       ;3         SECURITY ASSIGNED BY (RP200'), [0;3]

 +4       ;4         DATE/TIME SECURITY ASSIGNED (RD), [0;4]

 +5       ;5         SECURITY SOURCE (F), [0;5]

 +6       ;

 +7       ;FROM: ^DPT(PTID

 +8       ;          RACE INFORMATION (Multiple-2.02), [.02;0]

 +9       ;          .01  RACE INFORMATION (M*P10'X), [0;1]

 +10      ;          .02  METHOD OF COLLECTION (RP10.3'), [0;2]

 +11      ;

 +12      ;.352      DEATH ENTERED BY (P200'), [.35;2]

 +13      ;

 +14      ;6         ETHNICITY INFORMATION (Multiple-2.06), [.06;0]

 +15      ;          .01  ETHNICITY INFORMATION (*P10.2'X), [0;1]

 +16      ;          .02  METHOD OF COLLECTION (RP10.3'), [0;2]

 +17      ;          

 +18      ;Primary Care Provider - Use $$NMPCPR^SCAPMCU2(PTID,DT,1) API to

 +19      ;          retrieve Primary Care Provider.  Call VPID^XUPS API to

 +20      ;          convert DUZ to VPID.                    

 +21      ;

GETPSARY(PSARRAY) ;

 +1        NEW CNT

 +2        SET CNT=$GET(CNT)+1

           SET PSARRAY(CNT)="<DataSet Name='SecondaryDemographics'"

 +3        SET CNT=$GET(CNT)+1

           SET PSARRAY(CNT)="^SecurityAssignedBy^"_$$SECASGBY()

 +4        SET CNT=$GET(CNT)+1

           SET PSARRAY(CNT)="^DateTimeSecurityAssigned^"_$$DTSECASG()

 +5        SET CNT=$GET(CNT)+1

           SET PSARRAY(CNT)="^SecuritySource^"_$$SECSOURC()

 +6        SET CNT=$GET(CNT)+1

           SET PSARRAY(CNT)="^PrimaryCareProvider^"_$$PCP()

 +7        DO ETHNINFO

 +8        DO RACEINFO

 +9        SET CNT=$GET(CNT)+1

           SET PSARRAY(CNT)="</DataSet>"_"^^^1"

 +10       QUIT 

 +11      ;

SECASGBY() ;

 +1        NEW DATA

 +2        SET DATA=$PIECE(GLOB(38.1),"^",3)

 +3        IF DATA'=""

               SET DATA=$PIECE($GET(^VA(200,DATA,0)),"^",1)

 +4        QUIT DATA

 +5       ;

DTSECASG() ;

 +1        QUIT $PIECE(GLOB(38.1),"^",4)

 +2       ;

SECSOURC() ;

 +1        QUIT $PIECE(GLOB(38.1),"^",5)

 +2       ;

DODENTBY() ;

 +1        NEW DATA

 +2        SET DATA=$PIECE(GLOB(.35),"^",2)

 +3        IF DATA'=""

               SET DATA=$PIECE($GET(^VA(200,DATA,0)),"^",1)

 +4        QUIT DATA

 +5       ;

DODVPID() ;

 +1       ;QUIT "200#ROOT"_$P(GLOB(.35),"^",2)

 +2        QUIT $$VPID^XUPS($PIECE(GLOB(.35),"^",2))

 +3       ;

PCP()     ;Primary Care Provider

 +1       ; get the PCP's IEN and convert to VPID (primary care physician)

 +2       ; 

 +3        NEW PATSPCP,PCPIEN,PCPVPID

 +4        SET PATSPCP=$$NMPCPR^SCAPMCU2(PTID,DT,1)

 +5        SET PCPIEN=$PIECE(PATSPCP,"^",1)

 +6        SET PCPVPID=$$VPID^XUPS(+PCPIEN)

 +7        QUIT PCPVPID

 +8       ;

ETHNINFO  ;

 +1        NEW ETHCNT,ROWCNT,ETHNIC,METHOD

 +2        SET ETHCNT=0

           SET ROWCNT=0

 +3        FOR 

               SET ETHCNT=$ORDER(^DPT(PTID,.06,ETHCNT))

               IF (ETHCNT<1)

                   QUIT 

               Begin DoDot:1

 +4                SET ETHNIC=$PIECE($GET(^DPT(PTID,.06,ETHCNT,0)),"^",1)

 +5                SET METHOD=$PIECE($GET(^DPT(PTID,.06,ETHCNT,0)),"^",2)

 +6                IF ETHNIC'=""

                       Begin DoDot:2

 +7                        SET ROWCNT=ROWCNT+1

 +8                        SET ETHNIC=$PIECE($GET(^DIC(10.2,ETHNIC,0)),"^",1)

 +9                        IF METHOD'=""

                               SET METHOD=$PIECE(^DIC(10.3,METHOD,0),"^",1)

 +10                       SET CNT=$GET(CNT)+1

                           SET PSARRAY(CNT)="><Ethnicity Row='"_ROWCNT_"'"

 +11                       SET CNT=$GET(CNT)+1

                           SET PSARRAY(CNT)="^Ethnicity^"_ETHNIC_"^^ETHNIC^"_ROWCNT

 +12                       SET CNT=$GET(CNT)+1

                           SET PSARRAY(CNT)="^MethodOfCollection^"_METHOD_"^^ETHNIC^"_ROWCNT

 +13                       SET CNT=$GET(CNT)+1

                           SET PSARRAY(CNT)="></Ethnicity>"

                       End DoDot:2

               End DoDot:1

 +14       IF ROWCNT=0

               Begin DoDot:1

 +15               SET CNT=$GET(CNT)+1

                   SET PSARRAY(CNT)="><Ethnicity Row='1' Ethnicity='' MethodOfCollection=''></Ethnicity>"

               End DoDot:1

 +16       QUIT 

 +17      ;

RACEINFO  ;

 +1        NEW RACECNT,ROWCNT,RACE,METHOD

 +2        SET RACECNT=0

           SET ROWCNT=0

 +3        FOR 

               SET RACECNT=$ORDER(^DPT(PTID,.02,RACECNT))

               IF (RACECNT<1)

                   QUIT 

               Begin DoDot:1

 +4                SET RACE=$PIECE($GET(^DPT(PTID,.02,RACECNT,0)),"^",1)

 +5                SET METHOD=$PIECE($GET(^DPT(PTID,.02,RACECNT,0)),"^",2)

 +6                IF RACE'=""

                       Begin DoDot:2

 +7                        SET ROWCNT=ROWCNT+1

 +8                        SET RACE=$PIECE($GET(^DIC(10,RACE,0)),"^",1)

 +9                        IF METHOD'=""

                               SET METHOD=$PIECE(^DIC(10.3,METHOD,0),"^",1)

 +10                       SET CNT=$GET(CNT)+1

                           SET PSARRAY(CNT)="<Race Row='"_ROWCNT_"'"

 +11                       SET CNT=$GET(CNT)+1

                           SET PSARRAY(CNT)="^Race^"_RACE_"^^RACE^"_ROWCNT

 +12                       SET CNT=$GET(CNT)+1

                           SET PSARRAY(CNT)="^MethodOfCollection^"_METHOD_"^^RACE^"_ROWCNT

 +13                       SET CNT=$GET(CNT)+1

                           SET PSARRAY(CNT)="></Race>"

                       End DoDot:2

               End DoDot:1

 +14       IF ROWCNT=0

               Begin DoDot:1

 +15               SET CNT=$GET(CNT)+1

                   SET PSARRAY(CNT)="<Race Row='1' Race='' MethodOfCollection=''></Race>"

               End DoDot:1

 +16       QUIT