AGSSPSZZ.m

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

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

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

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

 I AGSSN["QAA" W !,"AGSSI:",AGSSI,"SSN: ",AGSSN

 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

AGSSPSZZ  ; 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        NEW AGSSDATA,AGSSN,AGLOC,AGHRN,AGPSEUDO,DIC,DIE,DA,DR

 +2        IF (AGSSI#100)=0

               WRITE "*"

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

 +4        IF AGSSN["QAA"

               WRITE !,"AGSSI:",AGSSI,"SSN: ",AGSSN

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