AGSSPSDO.m

AGSSPSDO ; IHS/ADC/CRG -FILLING PSEUDO SSNS INTO BLANK SSNS ; 

 ;;7.1;PATIENT REGISTRATION;;AUG 25,2005

 ;

EN ;EP -

 ;This program stuffs PSEUDO SSNs into blank Patient SSNs fields.

 ;The Pseudo SSN is a combination of .31 of the Location file

 ;9999999.06 and the Health Record Number

 ;

LOOP ;Loop through all Patients checking SSN field

 S AGSSI=0 F  S AGSSI=$O(^AUPNPAT(AGSSI)) Q:+AGSSI=0  D IEN

 K AGSSI

 Q

IEN ;EP--Get IEN in pat file, Use data puller to get SSN, Location and HRN

 I (AGSSI#100)=0 W "."

 N AGSSDATA,AGSSN,AGLOC,AGHRN,AGPSEUDO,DIC,DIE,DA,DR

 S AGSSDATA=$G(^AUPNPAT(AGSSI,0))

 S AGSSN=$$VAL^XBDIQ1(2,AGSSI,.09)

 S AGLOC=$$VAL^XBDIQ1(9999999.06,DUZ(2),.31)

 I AGSSN[AGLOC S ^TMP("AG",$J,AGSSI)=AGSSI_"^"_AGSSN

 S AGHRN=$P($G(^AUPNPAT(AGSSI,41,DUZ(2),0)),"^",2)

 ;If an HRN exists compose a PSEUDO SSN made of Location code and HRN

 I AGHRN'="" D PSSN

 Q

PSSN ;Make sure HRN is 6 digits by packing 0s in leading positions

 I $L(AGHRN)<6 D

 .S AGHRN="00000"_AGHRN

 .S AGHRN=$E(AGHRN,($L(AGHRN)-5),$L(AGHRN))

 S AGPSEUDO=AGLOC_AGHRN

 ;Find all missing SSNs and stuff PSEUDO SSNs into Pat Records

 I AGSSN="" D

 .S DIC="^DPT("

 .S DIE=DIC

 .S DA=AGSSI

 .S DR=".09////^S X=AGPSEUDO"

 .D ^DIE

 Q

RESULTS ;Results

 W !,"NAME                           IEN      PSEUDO SSN"

 W !,"==================================================",!

 S AGSSJ=0 F  S AGSSJ=$O(^TMP("AG",$J,AGSSJ)) Q:+AGSSJ=0  D

 .S AGSSNAME=$P(^DPT(AGSSJ,0),"^",1)

 .S AGSSIEN=$P(^TMP("AG",$J,AGSSJ),"^",1)

 .S AGSSPSSN=$P(^TMP("AG",$J,AGSSJ),"^",2)

 .W !,AGSSNAME,?30,AGSSIEN,?40,AGSSPSSN

 K AGSSJ,AGSSNAME,AGSSIEN,AGSSPSSN,^TMP("AG",$J)

 Q

AGSSPSDO  ; IHS/ADC/CRG -FILLING PSEUDO SSNS INTO BLANK SSNS ; 

 +1       ;;7.1;PATIENT REGISTRATION;;AUG 25,2005

 +2       ;

EN        ;EP -

 +1       ;This program stuffs PSEUDO SSNs into blank Patient SSNs fields.

 +2       ;The Pseudo SSN is a combination of .31 of the Location file

 +3       ;9999999.06 and the Health Record Number

 +4       ;

LOOP      ;Loop through all Patients checking SSN field

 +1        SET AGSSI=0

           FOR 

               SET AGSSI=$ORDER(^AUPNPAT(AGSSI))

               IF +AGSSI=0

                   QUIT 

               DO IEN

 +2        KILL AGSSI

 +3        QUIT 

IEN       ;EP--Get IEN in pat file, Use data puller to get SSN, Location and HRN

 +1        IF (AGSSI#100)=0

               WRITE "."

 +2        NEW AGSSDATA,AGSSN,AGLOC,AGHRN,AGPSEUDO,DIC,DIE,DA,DR

 +3        SET AGSSDATA=$GET(^AUPNPAT(AGSSI,0))

 +4        SET AGSSN=$$VAL^XBDIQ1(2,AGSSI,.09)

 +5        SET AGLOC=$$VAL^XBDIQ1(9999999.06,DUZ(2),.31)

 +6        IF AGSSN[AGLOC

               SET ^TMP("AG",$JOB,AGSSI)=AGSSI_"^"_AGSSN

 +7        SET AGHRN=$PIECE($GET(^AUPNPAT(AGSSI,41,DUZ(2),0)),"^",2)

 +8       ;If an HRN exists compose a PSEUDO SSN made of Location code and HRN

 +9        IF AGHRN'=""

               DO PSSN

 +10       QUIT 

PSSN      ;Make sure HRN is 6 digits by packing 0s in leading positions

 +1        IF $LENGTH(AGHRN)<6

               Begin DoDot:1

 +2                SET AGHRN="00000"_AGHRN

 +3                SET AGHRN=$EXTRACT(AGHRN,($LENGTH(AGHRN)-5),$LENGTH(AGHRN))

               End DoDot:1

 +4        SET AGPSEUDO=AGLOC_AGHRN

 +5       ;Find all missing SSNs and stuff PSEUDO SSNs into Pat Records

 +6        IF AGSSN=""

               Begin DoDot:1

 +7                SET DIC="^DPT("

 +8                SET DIE=DIC

 +9                SET DA=AGSSI

 +10               SET DR=".09////^S X=AGPSEUDO"

 +11               DO ^DIE

               End DoDot:1

 +12       QUIT 

RESULTS   ;Results

 +1        WRITE !,"NAME                           IEN      PSEUDO SSN"

 +2        WRITE !,"==================================================",!

 +3        SET AGSSJ=0

           FOR 

               SET AGSSJ=$ORDER(^TMP("AG",$JOB,AGSSJ))

               IF +AGSSJ=0

                   QUIT 

               Begin DoDot:1

 +4                SET AGSSNAME=$PIECE(^DPT(AGSSJ,0),"^",1)

 +5                SET AGSSIEN=$PIECE(^TMP("AG",$JOB,AGSSJ),"^",1)

 +6                SET AGSSPSSN=$PIECE(^TMP("AG",$JOB,AGSSJ),"^",2)

 +7                WRITE !,AGSSNAME,?30,AGSSIEN,?40,AGSSPSSN

               End DoDot:1

 +8        KILL AGSSJ,AGSSNAME,AGSSIEN,AGSSPSSN,^TMP("AG",$JOB)

 +9        QUIT