AG3A.m

AG3A ; IHS/ASDS/EFG - ENTER & EDIT NON-MANDATORY DATA ;  

 ;;7.1;PATIENT REGISTRATION;**4,12**;AUG 25,2005;Build 1

 ;

 ;AG*7.1 #  IHS/SD/TPF 

 ; ADDED SITE SPECIFIC MANDATORY FIELD CHECK AT SSN+8

 ; ADDED CHECK FOR SITE MANDATORY FIELDS MAILING ADDRESSES,PHONE

 ;IHS/OIT/NKD AG*7.1*12 PATIENT RESIDENCE

 ;

SSN ;EP - Social Security Number.

 N AGVERFY S AGVERFY=0  ;VERIFIED FLAG AG*7.1*4

 S AGOLD("SSN")=$P(^DPT(DFN,0),U,9)

 I $P(^AUPNPAT(DFN,0),U,23)]"" D        ;SSN VERIFICATION STATUS

 .I $D(^AUTTSSN($P(^AUPNPAT(DFN,0),U,23),0)) D

 .. I "V"[$P(^AUTTSSN($P(^AUPNPAT(DFN,0),U,23),0),U) D

 ... S AGVERFY=1  ;VERIFIED FLAG AG*7.1*4

 ... ;IHS/SD/TPF AG*7.1*4 TAKE OUT MESSAGE BELOW

 ... ;W !!,*7,"The SSN has been Verfied by the SSA do not change it unless you're"

 ... ;W !,"that it is incorrect!"

 D S2

 I $$ISREQ^AGFLDREQ(2,.09) S DIE("NO^")="",DR=".09R"

 E  S DR=.09

 ;IHS/SD/TPF AG*7.1*4 ADD MESSAGE

 I AGVERFY D  Q

 .W !,"THE SSN HAS BEEN VERIFIED BY THE SSA AND CANNOT BE EDITED."

 .K DIR

 .S DIR(0)="E"

 .D ^DIR

 ;END IHS/SD/TPF AG*7.1*4 

 ;

 D END

 I $P(^DPT(DFN,0),"^",9)'=AGOLD("SSN") D

 . S DIE="^AUPNPAT("

 . S DA=DFN

 . S DR=".23///@"  ;SSN VERIFICATION STATUS

 . D ^DIE

 K AGOLD("SSN")

 Q:$G(DUOUT)

 G NOSSN:$P(^DPT(DFN,0),U,9)=""

 I $P(^AUPNPAT(DFN,0),U,24)]"" D

 . S DIE="^AUPNPAT("

 . S DA=DFN

 . S DR=".24///@"    ;REASON FOR NO SSN

 . D ^DIE

 Q

 ;

NOSSN ;EP

 W *7,!!!?5,"*************************** SSN MISSING ***************************"

 W !?5,"The SSN is Required, Please indicate the Reason for Non-collection."

 W !?16,"(If the SSN is known, press RETURN to enter it)"

 K DIR

 S DIR(0)="SO^1:Not Available;2:Patient Refused;3:Patient will Submit"

 S DIR("A")="REASON for No SSN"

 D ^DIR

 K DIR

 Q:Y="^"

 G SSN:$D(DIRUT)!$D(DIROUT)

 S DIE="^AUPNPAT("

 S DA=DFN

 S DR=".24////"_Y

 D ^DIE

 Q

COB ;EP - City of Birth.

 D S2

 S DR=.092

 D END

 Q

SOB ;EP - State Of Birth.

 D S2

 S DR=.093

 D END

 Q

 ;IHS/OIT/NKD AG*7.1*12

PRES ;EP - Patient Residence

 D S1

 S DR="1803//HOME"

 D END

 Q

 ;

 ;NEW CODE AG*7.1*4 THIS WAS TAKEN BACK OUTPER BEAT SITE REQUEST

ALLADDR ;EP - EDIT ALL ADDRESSES - CONFIRM TO ADD TO PRVIOUS ADDRESS MULTIPLE

 N OLDST,OLDADDR2,OLDADDR3,OLDCITY,OLDSTATE,OLDZIP,OLDHPH

 N NEWST,NEWADDR2,NEWADDR3,NEWCITY,NEWSTATE,NEWZIP,NEWHPH

 S OLDST=$$GET1^DIQ(2,DFN_",",.111)

 S OLDADDR2=$$GET1^DIQ(2,DFN_",",.112)

 S OLDADDR3=$$GET1^DIQ(2,DFN_",",.113)

 S OLDCITY=$$GET1^DIQ(2,DFN_",",.114)

 S OLDSTATE=$$GET1^DIQ(2,DFN_",",.115)

 S OLDZIP=$$GET1^DIQ(2,DFN_",",.116)

 S OLDHPH=$$GET1^DIQ(2,DFN_",",.131)

ALLADDR1 D ST

ALLADDR2 D ADDR2^AGED1

ALLADDR3 D ADDR3^AGED1

ALLADDR4 D CITY

ALLADDR5 D STATE

ALLADDR6 D ZIP

ALLADDR7 D HPH

 S NEWST=$$GET1^DIQ(2,DFN_",",.111)

 S NEWADDR2=$$GET1^DIQ(2,DFN_",",.112)

 S NEWADDR3=$$GET1^DIQ(2,DFN_",",.113)

 S NEWCITY=$$GET1^DIQ(2,DFN_",",.114)

 S NEWSTATE=$$GET1^DIQ(2,DFN_",",.115)

 S NEWZIP=$$GET1^DIQ(2,DFN_",",.116)

 S NEWHPH=$$GET1^DIQ(2,DFN_",",.131)

ASKADD ;EP - ADD ADDRESS AS HISTORICAL

 Q:$G(OLDST)=$G(NEWST)&($G(OLDADDR2)=$G(NEWADDR2))&($G(OLDADDR3)=$G(NEWADDR3))&($G(OLDCITY)=$G(NEWCITY))&($G(OLDSTATE)=$G(NEWSTATE))&($G(OLDZIP)=$G(NEWZIP))&($G(OLDHPH)=$G(NEWHPH))

 N DUOUT,DTOUT,DFOUT

 K DIR

 S DIR(0)="Y"

 S DIR("A")="Should this new mail address be added to the historical addresses"

 S DIR("B")="Y"

 D ^DIR

 Q:'Y!$D(DTOUT)!$D(DUOUT)

 W !!,"Adding to PREVIOUS MAIL ADDRESSES FIELD...." H 2

 D UPDTHADD^AGUTILS(DFN,"N")  ;N SIGNIFIES THIS IS AN EDIT AND NOT A POST INSTALL FORCE

 Q

 ;END NEW CODE

 ;

ST ;EP - Mailing Street Address.

 S OLDST=$$GET1^DIQ(2,DFN_",",.111)  ;AG*7.1*4

 D S2

 I $$ISREQ^AGFLDREQ(2,.111) S DIE("NO^")="",DR=".111R"

 E  S DR=.111

 D END

 S NEWST=$$GET1^DIQ(2,DFN_",",.111)  ;AG*7.1*4

 Q

CITY ;EP - Mailing City.

 S OLDCITY=$$GET1^DIQ(2,DFN_",",.114)  ;AG*7.1*4 

 D S2

 I $$ISREQ^AGFLDREQ(2,.114) S DIE("NO^")="",DR=".114R"

 E  S DR=.114

 D END

 S NEWCITY=$$GET1^DIQ(2,DFN_",",.114)  ;AG*7.1*4

 ;GO TO PREVIOUS QUESTION IF TIMED OUT

 Q:$D(DTOUT)

 W *7,!!,"*** If you changed the city, you may need to change the"

 W !,"*** Community of Residence fields shown below."

 W !,"*** If not, just press RETURN to continue.",!

 D EDCOM^AG2B

 Q

STATE ;EP - Mailing State.

 S OLDSTATE=$$GET1^DIQ(2,DFN_",",.115)  ;AG*7.1*4

 D S2

 S DR=.115

 I $$ISREQ^AGFLDREQ(2,.115) S DIE("NO^")="",DR=".115R"

 E  S DR=.115

 D END

 S NEWSTATE=$$GET1^DIQ(2,DFN_",",.115)  ;AG*7.1*4

 Q

ZIP ;EP - Mailing Zip.

 S OLDZIP=$$GET1^DIQ(2,DFN_",",.116)   ;AG*7.1*4

 D S2

 I $D(DPTFLAG) S DR=.1112

 E  D

 .I $$ISREQ^AGFLDREQ(2,.116) S DIE("NO^")="",DR=".116R"

 .E  S DR=.116

 D END

 S NEWZIP=$$GET1^DIQ(2,DFN_",",.116)  ;AG*7.1*4

 Q

HPH ;EP - Home Phone #.

 S OLDHPH=$$GET1^DIQ(2,DFN_",",.131)  ;AG*7.1*4

 D S2

 I $$ISREQ^AGFLDREQ(2,.131) S DIE("NO^")="",DR=".131R"

 E  S DR=.131

 D END

 S NEWHPH=$$GET1^DIQ(2,DFN_",",.131)  ;AG*7.1*4

 Q

OPH ;EP - Office Phone #.

 D S2

 S DR=.132

 D END

 Q

ALIAS ;ENTER OTHER NAMES

 D S2

 K DR

 S DR=1

 S DR(2,2.01)=.01

 D END

 Q

S1 ;

 K DUOUT

 S DIE="^AUPNPAT("

 S DA=DFN

 W !

 Q

S2 ;

 K DUOUT

 S DIE="^DPT("

 S DA=DFN

 W !

 Q

END ;

 D ^DIE

 S:$D(Y) DUOUT=""

 Q

END2 ;

 Q

AG3A      ; IHS/ASDS/EFG - ENTER & EDIT NON-MANDATORY DATA ;  

 +1       ;;7.1;PATIENT REGISTRATION;**4,12**;AUG 25,2005;Build 1

 +2       ;

 +3       ;AG*7.1 #  IHS/SD/TPF 

 +4       ; ADDED SITE SPECIFIC MANDATORY FIELD CHECK AT SSN+8

 +5       ; ADDED CHECK FOR SITE MANDATORY FIELDS MAILING ADDRESSES,PHONE

 +6       ;IHS/OIT/NKD AG*7.1*12 PATIENT RESIDENCE

 +7       ;

SSN       ;EP - Social Security Number.

 +1       ;VERIFIED FLAG AG*7.1*4

           NEW AGVERFY

           SET AGVERFY=0

 +2        SET AGOLD("SSN")=$PIECE(^DPT(DFN,0),U,9)

 +3       ;SSN VERIFICATION STATUS

           IF $PIECE(^AUPNPAT(DFN,0),U,23)]""

               Begin DoDot:1

 +4                IF $DATA(^AUTTSSN($PIECE(^AUPNPAT(DFN,0),U,23),0))

                       Begin DoDot:2

 +5                        IF "V"[$PIECE(^AUTTSSN($PIECE(^AUPNPAT(DFN,0),U,23),0),U)

                               Begin DoDot:3

 +6       ;VERIFIED FLAG AG*7.1*4

                                   SET AGVERFY=1

 +7       ;IHS/SD/TPF AG*7.1*4 TAKE OUT MESSAGE BELOW

 +8       ;W !!,*7,"The SSN has been Verfied by the SSA do not change it unless you're"

 +9       ;W !,"that it is incorrect!"

                               End DoDot:3

                       End DoDot:2

               End DoDot:1

 +10       DO S2

 +11       IF $$ISREQ^AGFLDREQ(2,.09)

               SET DIE("NO^")=""

               SET DR=".09R"

 +12      IF '$TEST

               SET DR=.09

 +13      ;IHS/SD/TPF AG*7.1*4 ADD MESSAGE

 +14       IF AGVERFY

               Begin DoDot:1

 +15               WRITE !,"THE SSN HAS BEEN VERIFIED BY THE SSA AND CANNOT BE EDITED."

 +16               KILL DIR

 +17               SET DIR(0)="E"

 +18               DO ^DIR

               End DoDot:1

               QUIT 

 +19      ;END IHS/SD/TPF AG*7.1*4 

 +20      ;

 +21       DO END

 +22       IF $PIECE(^DPT(DFN,0),"^",9)'=AGOLD("SSN")

               Begin DoDot:1

 +23               SET DIE="^AUPNPAT("

 +24               SET DA=DFN

 +25      ;SSN VERIFICATION STATUS

                   SET DR=".23///@"

 +26               DO ^DIE

               End DoDot:1

 +27       KILL AGOLD("SSN")

 +28       IF $GET(DUOUT)

               QUIT 

 +29       IF $PIECE(^DPT(DFN,0),U,9)=""

               GOTO NOSSN

 +30       IF $PIECE(^AUPNPAT(DFN,0),U,24)]""

               Begin DoDot:1

 +31               SET DIE="^AUPNPAT("

 +32               SET DA=DFN

 +33      ;REASON FOR NO SSN

                   SET DR=".24///@"

 +34               DO ^DIE

               End DoDot:1

 +35       QUIT 

 +36      ;

NOSSN     ;EP

 +1        WRITE *7,!!!?5,"*************************** SSN MISSING ***************************"

 +2        WRITE !?5,"The SSN is Required, Please indicate the Reason for Non-collection."

 +3        WRITE !?16,"(If the SSN is known, press RETURN to enter it)"

 +4        KILL DIR

 +5        SET DIR(0)="SO^1:Not Available;2:Patient Refused;3:Patient will Submit"

 +6        SET DIR("A")="REASON for No SSN"

 +7        DO ^DIR

 +8        KILL DIR

 +9        IF Y="^"

               QUIT 

 +10       IF $DATA(DIRUT)!$DATA(DIROUT)

               GOTO SSN

 +11       SET DIE="^AUPNPAT("

 +12       SET DA=DFN

 +13       SET DR=".24////"_Y

 +14       DO ^DIE

 +15       QUIT 

COB       ;EP - City of Birth.

 +1        DO S2

 +2        SET DR=.092

 +3        DO END

 +4        QUIT 

SOB       ;EP - State Of Birth.

 +1        DO S2

 +2        SET DR=.093

 +3        DO END

 +4        QUIT 

 +5       ;IHS/OIT/NKD AG*7.1*12

PRES      ;EP - Patient Residence

 +1        DO S1

 +2        SET DR="1803//HOME"

 +3        DO END

 +4        QUIT 

 +5       ;

 +6       ;NEW CODE AG*7.1*4 THIS WAS TAKEN BACK OUTPER BEAT SITE REQUEST

ALLADDR   ;EP - EDIT ALL ADDRESSES - CONFIRM TO ADD TO PRVIOUS ADDRESS MULTIPLE

 +1        NEW OLDST,OLDADDR2,OLDADDR3,OLDCITY,OLDSTATE,OLDZIP,OLDHPH

 +2        NEW NEWST,NEWADDR2,NEWADDR3,NEWCITY,NEWSTATE,NEWZIP,NEWHPH

 +3        SET OLDST=$$GET1^DIQ(2,DFN_",",.111)

 +4        SET OLDADDR2=$$GET1^DIQ(2,DFN_",",.112)

 +5        SET OLDADDR3=$$GET1^DIQ(2,DFN_",",.113)

 +6        SET OLDCITY=$$GET1^DIQ(2,DFN_",",.114)

 +7        SET OLDSTATE=$$GET1^DIQ(2,DFN_",",.115)

 +8        SET OLDZIP=$$GET1^DIQ(2,DFN_",",.116)

 +9        SET OLDHPH=$$GET1^DIQ(2,DFN_",",.131)

ALLADDR1   DO ST

ALLADDR2   DO ADDR2^AGED1

ALLADDR3   DO ADDR3^AGED1

ALLADDR4   DO CITY

ALLADDR5   DO STATE

ALLADDR6   DO ZIP

ALLADDR7   DO HPH

 +1        SET NEWST=$$GET1^DIQ(2,DFN_",",.111)

 +2        SET NEWADDR2=$$GET1^DIQ(2,DFN_",",.112)

 +3        SET NEWADDR3=$$GET1^DIQ(2,DFN_",",.113)

 +4        SET NEWCITY=$$GET1^DIQ(2,DFN_",",.114)

 +5        SET NEWSTATE=$$GET1^DIQ(2,DFN_",",.115)

 +6        SET NEWZIP=$$GET1^DIQ(2,DFN_",",.116)

 +7        SET NEWHPH=$$GET1^DIQ(2,DFN_",",.131)

ASKADD    ;EP - ADD ADDRESS AS HISTORICAL

 +1        IF $GET(OLDST)=$GET(NEWST)&($GET(OLDADDR2)=$GET(NEWADDR2))&($GET(OLDADDR3)=$GET(NEWADDR3))&($GET(OLDCITY)=$GET(NEWCITY))&($GET(OLDSTATE)=$GET(NEWSTATE))&($GET(OLDZIP)=$GET(NEWZIP))&($GET(OLDHPH)=$GET(NEWHPH))

               QUIT 

 +2        NEW DUOUT,DTOUT,DFOUT

 +3        KILL DIR

 +4        SET DIR(0)="Y"

 +5        SET DIR("A")="Should this new mail address be added to the historical addresses"

 +6        SET DIR("B")="Y"

 +7        DO ^DIR

 +8        IF 'Y!$DATA(DTOUT)!$DATA(DUOUT)

               QUIT 

 +9        WRITE !!,"Adding to PREVIOUS MAIL ADDRESSES FIELD...."

           HANG 2

 +10      ;N SIGNIFIES THIS IS AN EDIT AND NOT A POST INSTALL FORCE

           DO UPDTHADD^AGUTILS(DFN,"N")

 +11       QUIT 

 +12      ;END NEW CODE

 +13      ;

ST        ;EP - Mailing Street Address.

 +1       ;AG*7.1*4

           SET OLDST=$$GET1^DIQ(2,DFN_",",.111)

 +2        DO S2

 +3        IF $$ISREQ^AGFLDREQ(2,.111)

               SET DIE("NO^")=""

               SET DR=".111R"

 +4       IF '$TEST

               SET DR=.111

 +5        DO END

 +6       ;AG*7.1*4

           SET NEWST=$$GET1^DIQ(2,DFN_",",.111)

 +7        QUIT 

CITY      ;EP - Mailing City.

 +1       ;AG*7.1*4 

           SET OLDCITY=$$GET1^DIQ(2,DFN_",",.114)

 +2        DO S2

 +3        IF $$ISREQ^AGFLDREQ(2,.114)

               SET DIE("NO^")=""

               SET DR=".114R"

 +4       IF '$TEST

               SET DR=.114

 +5        DO END

 +6       ;AG*7.1*4

           SET NEWCITY=$$GET1^DIQ(2,DFN_",",.114)

 +7       ;GO TO PREVIOUS QUESTION IF TIMED OUT

 +8        IF $DATA(DTOUT)

               QUIT 

 +9        WRITE *7,!!,"*** If you changed the city, you may need to change the"

 +10       WRITE !,"*** Community of Residence fields shown below."

 +11       WRITE !,"*** If not, just press RETURN to continue.",!

 +12       DO EDCOM^AG2B

 +13       QUIT 

STATE     ;EP - Mailing State.

 +1       ;AG*7.1*4

           SET OLDSTATE=$$GET1^DIQ(2,DFN_",",.115)

 +2        DO S2

 +3        SET DR=.115

 +4        IF $$ISREQ^AGFLDREQ(2,.115)

               SET DIE("NO^")=""

               SET DR=".115R"

 +5       IF '$TEST

               SET DR=.115

 +6        DO END

 +7       ;AG*7.1*4

           SET NEWSTATE=$$GET1^DIQ(2,DFN_",",.115)

 +8        QUIT 

ZIP       ;EP - Mailing Zip.

 +1       ;AG*7.1*4

           SET OLDZIP=$$GET1^DIQ(2,DFN_",",.116)

 +2        DO S2

 +3        IF $DATA(DPTFLAG)

               SET DR=.1112

 +4       IF '$TEST

               Begin DoDot:1

 +5                IF $$ISREQ^AGFLDREQ(2,.116)

                       SET DIE("NO^")=""

                       SET DR=".116R"

 +6               IF '$TEST

                       SET DR=.116

               End DoDot:1

 +7        DO END

 +8       ;AG*7.1*4

           SET NEWZIP=$$GET1^DIQ(2,DFN_",",.116)

 +9        QUIT 

HPH       ;EP - Home Phone #.

 +1       ;AG*7.1*4

           SET OLDHPH=$$GET1^DIQ(2,DFN_",",.131)

 +2        DO S2

 +3        IF $$ISREQ^AGFLDREQ(2,.131)

               SET DIE("NO^")=""

               SET DR=".131R"

 +4       IF '$TEST

               SET DR=.131

 +5        DO END

 +6       ;AG*7.1*4

           SET NEWHPH=$$GET1^DIQ(2,DFN_",",.131)

 +7        QUIT 

OPH       ;EP - Office Phone #.

 +1        DO S2

 +2        SET DR=.132

 +3        DO END

 +4        QUIT 

ALIAS     ;ENTER OTHER NAMES

 +1        DO S2

 +2        KILL DR

 +3        SET DR=1

 +4        SET DR(2,2.01)=.01

 +5        DO END

 +6        QUIT 

S1        ;

 +1        KILL DUOUT

 +2        SET DIE="^AUPNPAT("

 +3        SET DA=DFN

 +4        WRITE !

 +5        QUIT 

S2        ;

 +1        KILL DUOUT

 +2        SET DIE="^DPT("

 +3        SET DA=DFN

 +4        WRITE !

 +5        QUIT 

END       ;

 +1        DO ^DIE

 +2        IF $DATA(Y)

               SET DUOUT=""

 +3        QUIT 

END2      ;

 +1        QUIT