BDWAID.m

BDWAID ; IHS/CMI/LAB - UNIQUE REGISTRATION RECORD ID ;

 ;;1.0;IHS DATA WAREHOUSE;**3**;JAN 23, 2006

 ;

UID(BDWA) ;PEP-Given DFN return unique patient record id.

 ; BDWA can be DFN, but is not required if DFN or DA exists.

 ;

 ; pt record id = 6DIGIT_PADDFN

 ;     where 6DIGIT is the ASUFAC at the time of implementation of

 ;     this functionality.  I.e., the existing ASUFAC was frozen and

 ;     stuffed into the .25 field of the RPMS SITE file.

 ; PADDFN = DFN right justified in a field of 10.

 ;

 ; If not there, stuff the ASUFAC into RPMS SITE for durability.

 ;I '$P($G(^AUTTSITE(1,1)),U,3) S $P(^AUTTSITE(1,1),U,3)=$P(^AUTTLOC($P(^AUTTSITE(1,0),U,1),0),U,10)

 ;

 ; If BDWA is not specified, try DFN, then DA if DIC=AUPNPAT.

 I '$G(BDWA),$G(DFN) S BDWA=DFN

 I '$G(BDWA),$G(DA),$G(DIC)="^AUPNPAT(" S BDWA=DA

 ;

 I '$G(BDWA) Q "DFN undefined."

 I '$D(^AUPNPAT(BDWA)) Q "No entry in AUPNPAT(."

 ;

 Q $$GET1^DIQ(9999999.06,$P(^AUTTSITE(1,0),U),.32)_$E("0000000000",1,10-$L(BDWA))_BDWA

 ;

UIDV(VISIT) ;EP - generate unique ID for visit

 I '$G(VISIT) Q VISIT

 NEW X

 ;I '$P($G(^AUTTSITE(1,1)),"^",3) S $P(^AUTTSITE(1,1),"^",3)=$P(^AUTTLOC($P(^AUTTSITE(1,0),"^",1),0),"^",10)

 S X=$$GET1^DIQ(9999999.06,$P(^AUTTSITE(1,0),U),.32)

 Q X_$$LZERO(VISIT,10)

 ;

ICN(BDWA) ;-- return the ICN number and concat in PID-3

 I '$G(BDWA),$G(DFN) S BDWA=DFN

 Q $$GET1^DIQ(2,BDWA,991.01)

 ;

LZERO(V,L) ;EP - left zero fill

 NEW %,I

 S %=$L(V),Z=L-% F I=1:1:Z S V="0"_V

 Q V

BDWAID    ; IHS/CMI/LAB - UNIQUE REGISTRATION RECORD ID ;

 +1       ;;1.0;IHS DATA WAREHOUSE;**3**;JAN 23, 2006

 +2       ;

UID(BDWA) ;PEP-Given DFN return unique patient record id.

 +1       ; BDWA can be DFN, but is not required if DFN or DA exists.

 +2       ;

 +3       ; pt record id = 6DIGIT_PADDFN

 +4       ;     where 6DIGIT is the ASUFAC at the time of implementation of

 +5       ;     this functionality.  I.e., the existing ASUFAC was frozen and

 +6       ;     stuffed into the .25 field of the RPMS SITE file.

 +7       ; PADDFN = DFN right justified in a field of 10.

 +8       ;

 +9       ; If not there, stuff the ASUFAC into RPMS SITE for durability.

 +10      ;I '$P($G(^AUTTSITE(1,1)),U,3) S $P(^AUTTSITE(1,1),U,3)=$P(^AUTTLOC($P(^AUTTSITE(1,0),U,1),0),U,10)

 +11      ;

 +12      ; If BDWA is not specified, try DFN, then DA if DIC=AUPNPAT.

 +13       IF '$GET(BDWA)

               IF $GET(DFN)

                   SET BDWA=DFN

 +14       IF '$GET(BDWA)

               IF $GET(DA)

                   IF $GET(DIC)="^AUPNPAT("

                       SET BDWA=DA

 +15      ;

 +16       IF '$GET(BDWA)

               QUIT "DFN undefined."

 +17       IF '$DATA(^AUPNPAT(BDWA))

               QUIT "No entry in AUPNPAT(."

 +18      ;

 +19       QUIT $$GET1^DIQ(9999999.06,$PIECE(^AUTTSITE(1,0),U),.32)_$EXTRACT("0000000000",1,10-$LENGTH(BDWA))_BDWA

 +20      ;

UIDV(VISIT) ;EP - generate unique ID for visit

 +1        IF '$GET(VISIT)

               QUIT VISIT

 +2        NEW X

 +3       ;I '$P($G(^AUTTSITE(1,1)),"^",3) S $P(^AUTTSITE(1,1),"^",3)=$P(^AUTTLOC($P(^AUTTSITE(1,0),"^",1),0),"^",10)

 +4        SET X=$$GET1^DIQ(9999999.06,$PIECE(^AUTTSITE(1,0),U),.32)

 +5        QUIT X_$$LZERO(VISIT,10)

 +6       ;

ICN(BDWA) ;-- return the ICN number and concat in PID-3

 +1        IF '$GET(BDWA)

               IF $GET(DFN)

                   SET BDWA=DFN

 +2        QUIT $$GET1^DIQ(2,BDWA,991.01)

 +3       ;

LZERO(V,L) ;EP - left zero fill

 +1        NEW %,I

 +2        SET %=$LENGTH(V)

           SET Z=L-%

           FOR I=1:1:Z

               SET V="0"_V

 +3        QUIT V