DGRRPSD3.m

DGRRPSD3 ; ALB/SGG - rtnDGRR PatientServices Demographics Tertiary ;09/30/03  ; Compiled November 4, 2003 12:01:00

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

 ;

 ;

DOC ;<DataSet Name='TertiaryDemographics'

 ;

 ;

 ;

 ;          NAME COMPONENTS

 ;.092      PLACE OF BIRTH [CITY] (F), [0;11]

 ;.093      PLACE OF BIRTH [STATE] (P5'), [0;12]

 ;.096      WHO ENTERED PATIENT (P200'I), [0;15]

 ;          WHO ENTERED PATIENT VPID FROM #200

 ;.097      DATE ENTERED INTO FILE (D), [0;16]

 ;.2401     FATHER'S NAME (FX), [.24;1]

 ;.2402     MOTHER'S NAME (FX), [.24;2]

 ;.2403     MOTHER'S MAIDEN NAME (FaX), [.24;3]      

 ;.07       OCCUPATION (F), [0;7]

 ; MULTIPLE BIRTH INDICATOR NEEDS SORTED $P(^DPT(PTID,"MPIMB"),"^").

 ;

 ;1         ALIAS (Multiple-2.01), [.01;0]

 ;          .01  ALIAS (MFX), [0;1]

 ;          1    ALIAS SSN (F), [0;2]

 ;          

GETPSARY(PSARRAY) ;

 NEW CNT

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

 SET CNT=$G(CNT)+1,PSARRAY(CNT)="^Last^"_$$LAST()

 SET CNT=$G(CNT)+1,PSARRAY(CNT)="^First^"_$$FIRST()

 SET CNT=$G(CNT)+1,PSARRAY(CNT)="^Middle^"_$$MIDDLE()

 SET CNT=$G(CNT)+1,PSARRAY(CNT)="^Prefix^"_$$PREFIX()

 SET CNT=$G(CNT)+1,PSARRAY(CNT)="^Suffix^"_$$SUFFIX()

 SET CNT=$G(CNT)+1,PSARRAY(CNT)="^Degree^"_$$DEGREE()

 SET CNT=$G(CNT)+1,PSARRAY(CNT)="^CityOfBirth^"_$$CITYOB()

 SET CNT=$G(CNT)+1,PSARRAY(CNT)="^StateOfBirth^"_$$STATEOB()

 SET CNT=$G(CNT)+1,PSARRAY(CNT)="^WhoEnteredPatientVPID^"_$$WHOVPID()

 SET CNT=$G(CNT)+1,PSARRAY(CNT)="^WhoEnteredPatient^"_$$ENTBYWHO()

 SET CNT=$G(CNT)+1,PSARRAY(CNT)="^DatePatientEntered^"_$$ENTDATE()

 SET CNT=$G(CNT)+1,PSARRAY(CNT)="^FathersName^"_$$DADNAME()

 SET CNT=$G(CNT)+1,PSARRAY(CNT)="^MothersName^"_$$MOMNAME()

 SET CNT=$G(CNT)+1,PSARRAY(CNT)="^MothersMaidenName^"_$$MADNAME()

 SET CNT=$G(CNT)+1,PSARRAY(CNT)="^Occupation^"_$$OCCUPAT()

 SET CNT=$G(CNT)+1,PSARRAY(CNT)="^MultipleBirthIndicator^"_$$MULTIBI()

 SET CNT=$G(CNT)+1,PSARRAY(CNT)=">"

 DO ALISINFO

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

 QUIT

 ;

LAST() QUIT $P(GLOB("NAME"),"^",1)

 ;

FIRST() QUIT $P(GLOB("NAME"),"^",2)

 ;

MIDDLE() QUIT $P(GLOB("NAME"),"^",3)

 ;

PREFIX() QUIT $P(GLOB("NAME"),"^",5)

 ;

SUFFIX() QUIT $P(GLOB("NAME"),"^",4)

 ;

DEGREE() QUIT $P(GLOB("NAME"),"^",6)

 ;

CITYOB() QUIT $P(GLOB(0),"^",11)

 ;

STATEOB() ;

 NEW DATA

 SET DATA=$P(GLOB(0),"^",12)

 IF DATA'="" SET DATA=$P($G(^DIC(5,DATA,0)),"^",2)

 QUIT DATA

 ;

ENTBYWHO() ;

 NEW DATA

 SET DATA=$P(GLOB(0),"^",15)

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

 QUIT DATA

 ;

WHOVPID() ;

 QUIT $$VPID^XUPS($P(GLOB(0),"^",15))

 ;

ENTDATE() QUIT $P(GLOB(0),"^",16)

 ;

DADNAME() QUIT $P(GLOB(.24),"^",1)

 ;

MOMNAME() QUIT $P(GLOB(.24),"^",2)

 ;

MADNAME() QUIT $P(GLOB(.24),"^",3)

 ;

OCCUPAT() QUIT $P(GLOB(0),"^",7)

 ;

MULTIBI() ;

 NEW DATA

 SET DATA=$P($G(^DPT(PTID,"MPIMB")),"^",1)

 SET DATA=$S(DATA="Y":"YES",DATA="N":"NO",1:"")

 QUIT DATA

 ;

ALISINFO ;

 NEW ALISCNT,ROWCNT,ALIS,ALISSSN

 SET ALISCNT=0,ROWCNT=0

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

 .SET ALIS=$P($G(^DPT(PTID,.01,ALISCNT,0)),"^",1)

 .SET ALISSSN=$P($G(^DPT(PTID,.01,ALISCNT,0)),"^",2)

 .IF +$L(ALIS_ALISSSN) DO

 ..SET ROWCNT=ROWCNT+1

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

 ..SET CNT=$G(CNT)+1,PSARRAY(CNT)="^Alias^"_ALIS_"^^ALIAS^"_ROWCNT

 ..SET CNT=$G(CNT)+1,PSARRAY(CNT)="^SSN^"_ALISSSN_"^^ALIAS^"_ROWCNT

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

 IF ROWCNT=0 DO

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

 QUIT

DGRRPSD3  ; ALB/SGG - rtnDGRR PatientServices Demographics Tertiary ;09/30/03  ; Compiled November 4, 2003 12:01:00

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

 +2       ;

 +3       ;

DOC       ;<DataSet Name='TertiaryDemographics'

 +1       ;

 +2       ;

 +3       ;

 +4       ;          NAME COMPONENTS

 +5       ;.092      PLACE OF BIRTH [CITY] (F), [0;11]

 +6       ;.093      PLACE OF BIRTH [STATE] (P5'), [0;12]

 +7       ;.096      WHO ENTERED PATIENT (P200'I), [0;15]

 +8       ;          WHO ENTERED PATIENT VPID FROM #200

 +9       ;.097      DATE ENTERED INTO FILE (D), [0;16]

 +10      ;.2401     FATHER'S NAME (FX), [.24;1]

 +11      ;.2402     MOTHER'S NAME (FX), [.24;2]

 +12      ;.2403     MOTHER'S MAIDEN NAME (FaX), [.24;3]      

 +13      ;.07       OCCUPATION (F), [0;7]

 +14      ; MULTIPLE BIRTH INDICATOR NEEDS SORTED $P(^DPT(PTID,"MPIMB"),"^").

 +15      ;

 +16      ;1         ALIAS (Multiple-2.01), [.01;0]

 +17      ;          .01  ALIAS (MFX), [0;1]

 +18      ;          1    ALIAS SSN (F), [0;2]

 +19      ;          

GETPSARY(PSARRAY) ;

 +1        NEW CNT

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

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

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

           SET PSARRAY(CNT)="^Last^"_$$LAST()

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

           SET PSARRAY(CNT)="^First^"_$$FIRST()

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

           SET PSARRAY(CNT)="^Middle^"_$$MIDDLE()

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

           SET PSARRAY(CNT)="^Prefix^"_$$PREFIX()

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

           SET PSARRAY(CNT)="^Suffix^"_$$SUFFIX()

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

           SET PSARRAY(CNT)="^Degree^"_$$DEGREE()

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

           SET PSARRAY(CNT)="^CityOfBirth^"_$$CITYOB()

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

           SET PSARRAY(CNT)="^StateOfBirth^"_$$STATEOB()

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

           SET PSARRAY(CNT)="^WhoEnteredPatientVPID^"_$$WHOVPID()

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

           SET PSARRAY(CNT)="^WhoEnteredPatient^"_$$ENTBYWHO()

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

           SET PSARRAY(CNT)="^DatePatientEntered^"_$$ENTDATE()

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

           SET PSARRAY(CNT)="^FathersName^"_$$DADNAME()

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

           SET PSARRAY(CNT)="^MothersName^"_$$MOMNAME()

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

           SET PSARRAY(CNT)="^MothersMaidenName^"_$$MADNAME()

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

           SET PSARRAY(CNT)="^Occupation^"_$$OCCUPAT()

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

           SET PSARRAY(CNT)="^MultipleBirthIndicator^"_$$MULTIBI()

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

           SET PSARRAY(CNT)=">"

 +20       DO ALISINFO

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

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

 +22       QUIT 

 +23      ;

LAST()     QUIT $PIECE(GLOB("NAME"),"^",1)

 +1       ;

FIRST()    QUIT $PIECE(GLOB("NAME"),"^",2)

 +1       ;

MIDDLE()   QUIT $PIECE(GLOB("NAME"),"^",3)

 +1       ;

PREFIX()   QUIT $PIECE(GLOB("NAME"),"^",5)

 +1       ;

SUFFIX()   QUIT $PIECE(GLOB("NAME"),"^",4)

 +1       ;

DEGREE()   QUIT $PIECE(GLOB("NAME"),"^",6)

 +1       ;

CITYOB()   QUIT $PIECE(GLOB(0),"^",11)

 +1       ;

STATEOB() ;

 +1        NEW DATA

 +2        SET DATA=$PIECE(GLOB(0),"^",12)

 +3        IF DATA'=""

               SET DATA=$PIECE($GET(^DIC(5,DATA,0)),"^",2)

 +4        QUIT DATA

 +5       ;

ENTBYWHO() ;

 +1        NEW DATA

 +2        SET DATA=$PIECE(GLOB(0),"^",15)

 +3        IF DATA'=""

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

 +4        QUIT DATA

 +5       ;

WHOVPID() ;

 +1        QUIT $$VPID^XUPS($PIECE(GLOB(0),"^",15))

 +2       ;

ENTDATE()  QUIT $PIECE(GLOB(0),"^",16)

 +1       ;

DADNAME()  QUIT $PIECE(GLOB(.24),"^",1)

 +1       ;

MOMNAME()  QUIT $PIECE(GLOB(.24),"^",2)

 +1       ;

MADNAME()  QUIT $PIECE(GLOB(.24),"^",3)

 +1       ;

OCCUPAT()  QUIT $PIECE(GLOB(0),"^",7)

 +1       ;

MULTIBI() ;

 +1        NEW DATA

 +2        SET DATA=$PIECE($GET(^DPT(PTID,"MPIMB")),"^",1)

 +3        SET DATA=$SELECT(DATA="Y":"YES",DATA="N":"NO",1:"")

 +4        QUIT DATA

 +5       ;

ALISINFO  ;

 +1        NEW ALISCNT,ROWCNT,ALIS,ALISSSN

 +2        SET ALISCNT=0

           SET ROWCNT=0

 +3        FOR 

               SET ALISCNT=$ORDER(^DPT(PTID,.01,ALISCNT))

               IF (ALISCNT<1)

                   QUIT 

               Begin DoDot:1

 +4                SET ALIS=$PIECE($GET(^DPT(PTID,.01,ALISCNT,0)),"^",1)

 +5                SET ALISSSN=$PIECE($GET(^DPT(PTID,.01,ALISCNT,0)),"^",2)

 +6                IF +$LENGTH(ALIS_ALISSSN)

                       Begin DoDot:2

 +7                        SET ROWCNT=ROWCNT+1

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

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

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

                           SET PSARRAY(CNT)="^Alias^"_ALIS_"^^ALIAS^"_ROWCNT

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

                           SET PSARRAY(CNT)="^SSN^"_ALISSSN_"^^ALIAS^"_ROWCNT

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

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

                       End DoDot:2

               End DoDot:1

 +12       IF ROWCNT=0

               Begin DoDot:1

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

                   SET PSARRAY(CNT)="<Alias Row='1' Alias='' SSN=''></Alias>"

               End DoDot:1

 +14       QUIT