AGSSUNDO.m

AGSSUNDO ; IHS/ADC/CRG -UNDO PSEUDO SSNS ; 

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

 ;

EN ;EP -

 ;This program stuffs blanks into Pseudo Patient SSNs fields.

 ;

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 D CLEAR

 Q

CLEAR ;Find all PSEUDO SSNs in Pat Records and delete them.

 S DIC="^DPT("

 S DIE=DIC

 S DA=AGSSI

 S DR=".09////@"

 D ^DIE

 Q

AGSSUNDO  ; IHS/ADC/CRG -UNDO PSEUDO SSNS ; 

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

 +2       ;

EN        ;EP -

 +1       ;This program stuffs blanks into Pseudo Patient SSNs fields.

 +2       ;

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

               DO CLEAR

 +7        QUIT 

CLEAR     ;Find all PSEUDO SSNs in Pat Records and delete them.

 +1        SET DIC="^DPT("

 +2        SET DIE=DIC

 +3        SET DA=AGSSI

 +4        SET DR=".09////@"

 +5        DO ^DIE

 +6        QUIT