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
