ASDREG ; IHS/ADC/PDW/ENM - REG EDITS ALLOWED FROM SCHEDULING ; [ 12/21/1999 2:31 PM ]
;;5.0;IHS SCHEDULING;**3,4**;MAR 25, 1999
;PEP; called by AMER1 to edit full registration
;
S SDSTOP=$O(^DIC(19,"B","AGEDIT",0))
I SDSTOP'="",$P(^DIC(19,SDSTOP,0),"^",3)'="" K SDSTOP Q
K SDSTOP
;
K DIE("NO^"),SDQUIT
;
EDITYP ; -- check user for edit type to use
NEW ASDREG
S ASDREG=$$VALI^XBDIQ1(40.8,$$DIV^ASDUT,9999999.09)
I 'ASDREG D DISPLAY Q
I $D(^XUSEC("SDZREGEDIT",DUZ)),ASDREG>1 D D END Q
. D DISREG K DIR S DIR(0)="Y",DIR("B")="NO"
. S DIR("A")="WANT TO EDIT REGISTRATION RECORD" D ^DIR K DIR
. Q:Y=0 I Y'=1 S ASDQUIT="" Q
. L +^AUPNPAT(DFN):3 I '$T D Q
.. W !,*7,"PATIENT ENTRY LOCKED; TRY AGAIN SOON"
. S DIE=9000001,DA=DFN,DR=".14" D ^DIE L -^AUPNPAT(DFN)
. D ^AGVAR S X="AGEDIT" D HDR^AG,DISPAT
. I $D(AGOPT(14)) D PATNLK^AGEDIT ;IHS/DSD/ENM 12/21/99 RESET TO ORIG CODE. PATCH 2 CHANGE WAS INCORRECT. REQUIRES AGEDIT PATCH 4
. D ^XBCLS W !! D DISPAT W !
;
DISPLAY ;PEP; -- display address then ask to edit
; to call at PEP have DFN set and ASDREG=1
; if you're sure user wants to edit, set ASDOK=1
NEW ASDR D ENP^XBDIQ1(2,DFN,".111;.114:.116;.131;.132","ASDR(")
S X=$$VAL^XBDIQ1(9000001,DFN,.03) W !?5,$$FIELD(9000001,.03),": ",X
W !!,ASDR(.111),!,ASDR(.114),", ",ASDR(.115)," ",ASDR(.116)
W !,ASDR(.131)," (home) ",ASDR(.132)," (work)",!!
I 'ASDREG!(ASDREG=3) D END Q
I '$G(ASDOK) D I Y'=1 D END Q
. NEW DIR S DIR(0)="Y0",DIR("B")="NO"
. S DIR("A")="Does patient's address or phone # need to be updated"
. D ^DIR
;
L +^AUPNPAT(DFN):3 I '$T D D END Q
. W !,*7,"PATIENT ENTRY LOCKED; TRY AGAIN SOON"
;
ST ; -- mailing address-street
S DR=.111 D PRESAVE,EDIT(2),POSTCK G END:$D(SDQUIT)
;
CITY ; -- mailing address-city
S DR=.114 D PRESAVE,EDIT(2),POSTCK
I SDPOST'=SDPRE D NOTE
G END:$D(DUOUT)
;
STATE ; -- mailing address-state
S DR=.115 D PRESAVE,EDIT(2),POSTCK G END:$D(SDQUIT)
;
ZIP ; -- mailing address-zip
S DR=.116 D PRESAVE,EDIT(2),POSTCK G END:$D(SDQUIT)
;
HPH ; -- home phone number
S DR=.131 D PRESAVE,EDIT(2),POSTCK G END:$D(SDQUIT)
;
WPH ; -- work phone number
S DR=.132 D PRESAVE,EDIT(2),POSTCK G END:$D(SDQUIT) W !!
;
END ; -- eoj
L -^AUPNPAT(DFN)
K DA,DR,DIE,X,SDPOST,SDPRE,SDQUIT,ASDOK,ASDREG
K AG,AGCHRT,AGLINE,AGOPT,AGPAT,AGQI,AGQT,AGSCRN,AGTP,AGUPDT
Q
;
;
PRESAVE ; -- SUBRTN to return before value of data
S SDPRE=$$VAL^XBDIQ1(2,DFN,DR) Q
;
POSTCK ; -- SUBRTN to return new value of data & set ^agpatch if needed
NEW X
S SDPOST=$$VAL^XBDIQ1(2,DFN,DR) I SDPOST=SDPRE Q
S X="NOW" D ^%DT S ^AGPATCH(Y,DUZ(2),DFN)=""
;HL7 CALL
S ^XTMP("AGHL7",DFN)=DFN
Q
;
EDIT(FILE) ; -- SUBRTN to set variables
S DIE=FILE,DA=DFN W ! D ^DIE S:$D(Y) SDQUIT="" Q
;
NOTE ;
W !!?24,"Mailing address-city has changed."
W !?9,"Please check to see if Community of Residence has changed also."
W !!?20,"If Community of Residence has changed,"
W !?9,"have patient notify admitting - it affects eligibility.",! Q
;
DISPAT ; displays patient name & identifiers
NEW ASDX
S ASDX=^DPT(DFN,0)
W !!?3,$P(ASDX,U),?40,$P(ASDX,U,2) ;name,sex
W ?45,$$FMTE^XLFDT($P(ASDX,U,3),2) ;dob
W ?55,$P(ASDX,U,9) ;ssn
W ?67,$$VAL^XBDIQ1(9999999.06,DUZ(2),.08) ;facility
W ?69,$J($P(^AUPNPAT(DFN,41,DUZ(2),0),U,2),7) ;hrcn
Q
;
DISREG ; displays last reg update and add. info
NEW X
W !!?3,$$REPEAT^XLFSTR("*",70)
S X=$$VAL^XBDIQ1(9000001,DFN,.03) W !?5,$$FIELD(9000001,.03),": ",X
W !!?5,"Additional Registration Information:"
S X=0 F S X=$O(^AUPNPAT(DFN,13,X)) Q:'X D
. W !?7,^AUPNPAT(DFN,13,X,0)
W !?3,$$REPEAT^XLFSTR("*",70),!
Q
;
FIELD(X,Y) ; -- returns name of field
Q $P($G(^DD(X,Y,0)),U)
ASDREG ; IHS/ADC/PDW/ENM - REG EDITS ALLOWED FROM SCHEDULING ; [ 12/21/1999 2:31 PM ]
+1 ;;5.0;IHS SCHEDULING;**3,4**;MAR 25, 1999
+2 ;PEP; called by AMER1 to edit full registration
+3 ;
+4 SET SDSTOP=$ORDER(^DIC(19,"B","AGEDIT",0))
+5 IF SDSTOP'=""
IF $PIECE(^DIC(19,SDSTOP,0),"^",3)'=""
KILL SDSTOP
QUIT
+6 KILL SDSTOP
+7 ;
+8 KILL DIE("NO^"),SDQUIT
+9 ;
EDITYP ; -- check user for edit type to use
+1 NEW ASDREG
+2 SET ASDREG=$$VALI^XBDIQ1(40.8,$$DIV^ASDUT,9999999.09)
+3 IF 'ASDREG
DO DISPLAY
QUIT
+4 IF $DATA(^XUSEC("SDZREGEDIT",DUZ))
IF ASDREG>1
Begin DoDot:1
+5 DO DISREG
KILL DIR
SET DIR(0)="Y"
SET DIR("B")="NO"
+6 SET DIR("A")="WANT TO EDIT REGISTRATION RECORD"
DO ^DIR
KILL DIR
+7 IF Y=0
QUIT
IF Y'=1
SET ASDQUIT=""
QUIT
+8 LOCK +^AUPNPAT(DFN):3
IF '$TEST
Begin DoDot:2
+9 WRITE !,*7,"PATIENT ENTRY LOCKED; TRY AGAIN SOON"
End DoDot:2
QUIT
+10 SET DIE=9000001
SET DA=DFN
SET DR=".14"
DO ^DIE
LOCK -^AUPNPAT(DFN)
+11 DO ^AGVAR
SET X="AGEDIT"
DO HDR^AG
DO DISPAT
+12 ;IHS/DSD/ENM 12/21/99 RESET TO ORIG CODE. PATCH 2 CHANGE WAS INCORRECT. REQUIRES AGEDIT PATCH 4
IF $DATA(AGOPT(14))
DO PATNLK^AGEDIT
+13 DO ^XBCLS
WRITE !!
DO DISPAT
WRITE !
End DoDot:1
DO END
QUIT
+14 ;
DISPLAY ;PEP; -- display address then ask to edit
+1 ; to call at PEP have DFN set and ASDREG=1
+2 ; if you're sure user wants to edit, set ASDOK=1
+3 NEW ASDR
DO ENP^XBDIQ1(2,DFN,".111;.114:.116;.131;.132","ASDR(")
+4 SET X=$$VAL^XBDIQ1(9000001,DFN,.03)
WRITE !?5,$$FIELD(9000001,.03),": ",X
+5 WRITE !!,ASDR(.111),!,ASDR(.114),", ",ASDR(.115)," ",ASDR(.116)
+6 WRITE !,ASDR(.131)," (home) ",ASDR(.132)," (work)",!!
+7 IF 'ASDREG!(ASDREG=3)
DO END
QUIT
+8 IF '$GET(ASDOK)
Begin DoDot:1
+9 NEW DIR
SET DIR(0)="Y0"
SET DIR("B")="NO"
+10 SET DIR("A")="Does patient's address or phone # need to be updated"
+11 DO ^DIR
End DoDot:1
IF Y'=1
DO END
QUIT
+12 ;
+13 LOCK +^AUPNPAT(DFN):3
IF '$TEST
Begin DoDot:1
+14 WRITE !,*7,"PATIENT ENTRY LOCKED; TRY AGAIN SOON"
End DoDot:1
DO END
QUIT
+15 ;
ST ; -- mailing address-street
+1 SET DR=.111
DO PRESAVE
DO EDIT(2)
DO POSTCK
IF $DATA(SDQUIT)
GOTO END
+2 ;
CITY ; -- mailing address-city
+1 SET DR=.114
DO PRESAVE
DO EDIT(2)
DO POSTCK
+2 IF SDPOST'=SDPRE
DO NOTE
+3 IF $DATA(DUOUT)
GOTO END
+4 ;
STATE ; -- mailing address-state
+1 SET DR=.115
DO PRESAVE
DO EDIT(2)
DO POSTCK
IF $DATA(SDQUIT)
GOTO END
+2 ;
ZIP ; -- mailing address-zip
+1 SET DR=.116
DO PRESAVE
DO EDIT(2)
DO POSTCK
IF $DATA(SDQUIT)
GOTO END
+2 ;
HPH ; -- home phone number
+1 SET DR=.131
DO PRESAVE
DO EDIT(2)
DO POSTCK
IF $DATA(SDQUIT)
GOTO END
+2 ;
WPH ; -- work phone number
+1 SET DR=.132
DO PRESAVE
DO EDIT(2)
DO POSTCK
IF $DATA(SDQUIT)
GOTO END
WRITE !!
+2 ;
END ; -- eoj
+1 LOCK -^AUPNPAT(DFN)
+2 KILL DA,DR,DIE,X,SDPOST,SDPRE,SDQUIT,ASDOK,ASDREG
+3 KILL AG,AGCHRT,AGLINE,AGOPT,AGPAT,AGQI,AGQT,AGSCRN,AGTP,AGUPDT
+4 QUIT
+5 ;
+6 ;
PRESAVE ; -- SUBRTN to return before value of data
+1 SET SDPRE=$$VAL^XBDIQ1(2,DFN,DR)
QUIT
+2 ;
POSTCK ; -- SUBRTN to return new value of data & set ^agpatch if needed
+1 NEW X
+2 SET SDPOST=$$VAL^XBDIQ1(2,DFN,DR)
IF SDPOST=SDPRE
QUIT
+3 SET X="NOW"
DO ^%DT
SET ^AGPATCH(Y,DUZ(2),DFN)=""
+4 ;HL7 CALL
+5 SET ^XTMP("AGHL7",DFN)=DFN
+6 QUIT
+7 ;
EDIT(FILE) ; -- SUBRTN to set variables
+1 SET DIE=FILE
SET DA=DFN
WRITE !
DO ^DIE
IF $DATA(Y)
SET SDQUIT=""
QUIT
+2 ;
NOTE ;
+1 WRITE !!?24,"Mailing address-city has changed."
+2 WRITE !?9,"Please check to see if Community of Residence has changed also."
+3 WRITE !!?20,"If Community of Residence has changed,"
+4 WRITE !?9,"have patient notify admitting - it affects eligibility.",!
QUIT
+5 ;
DISPAT ; displays patient name & identifiers
+1 NEW ASDX
+2 SET ASDX=^DPT(DFN,0)
+3 ;name,sex
WRITE !!?3,$PIECE(ASDX,U),?40,$PIECE(ASDX,U,2)
+4 ;dob
WRITE ?45,$$FMTE^XLFDT($PIECE(ASDX,U,3),2)
+5 ;ssn
WRITE ?55,$PIECE(ASDX,U,9)
+6 ;facility
WRITE ?67,$$VAL^XBDIQ1(9999999.06,DUZ(2),.08)
+7 ;hrcn
WRITE ?69,$JUSTIFY($PIECE(^AUPNPAT(DFN,41,DUZ(2),0),U,2),7)
+8 QUIT
+9 ;
DISREG ; displays last reg update and add. info
+1 NEW X
+2 WRITE !!?3,$$REPEAT^XLFSTR("*",70)
+3 SET X=$$VAL^XBDIQ1(9000001,DFN,.03)
WRITE !?5,$$FIELD(9000001,.03),": ",X
+4 WRITE !!?5,"Additional Registration Information:"
+5 SET X=0
FOR
SET X=$ORDER(^AUPNPAT(DFN,13,X))
IF 'X
QUIT
Begin DoDot:1
+6 WRITE !?7,^AUPNPAT(DFN,13,X,0)
End DoDot:1
+7 WRITE !?3,$$REPEAT^XLFSTR("*",70),!
+8 QUIT
+9 ;
FIELD(X,Y) ; -- returns name of field
+1 QUIT $PIECE($GET(^DD(X,Y,0)),U)
