AMERAGED ; IHS/OIT/SCR 06/22/06 - PATIENT REG ROUTINES
;;3.0;ER VISIT SYSTEM;;FEB 23, 2009
;
;;
NAME(AMERDFN) ; EP - From UPDATPAT^AMERVSIT
; Check for PATIENT REG 7.1 PATCH 2
; IF IT IS THERE RETURN VALUE FROM PATIENT REG API NAME^AGMANERS().
; IF NOT, RETURN VALUE FROM AMERNAME() BELOW
; Check for "AG" version 7.1 PATCH 1
NEW AMERPTCH,AMERAGPT,AMERPNTR,AMEROK,AMERAGV,AMERRTRN
S AMERRTRN=""
S AMERAGV=$$VERSION^XPDUTL("AG")
I AMERAGV'="7.1" S AMERRTRN=$$AMERNAME(AMERDFN) Q AMERRTRN ;IF Patient Reg Version is not 7.1, dont' look for patch 2
S AMERPNTR=$O(^DIC(9.4,"C","AG",0))
S AMERPTCH=0,AMEROK="NO"
F S AMERPTCH=$O(^DIC(9.4,AMERPNTR,22,AMERPTCH)) Q:AMERPTCH=""!(AMEROK="YES") D
.I $P($G(^DIC(9.4,AMERPNTR,22,AMERPTCH,0)),U,1)'="7.1" Q ;ONLY LOOK AT ENTRIES FOR VERSION 7.1
.S AMERAGPT=""
.F S AMERAGPT=$O(^DIC(9.4,AMERPNTR,22,AMERPTCH,"PAH",AMERAGPT)) Q:(AMERAGPT=""!(AMEROK="YES")) D
..I +$G(^DIC(9.4,AMERPNTR,22,AMERPTCH,"PAH",AMERAGPT,0))[2 S AMEROK="YES"
..Q
.Q
I AMEROK="YES" S AMERRTN=$$NAME^AGMANERS(AMERDFN)
I AMEROK'="YES" S AMERRTN=$$AMERNAME(AMERDFN)
Q AMERRTN
;
; All of the following code will be replaced by NAME^AGMANERS when AG*7.1*2 IS RELEASED
AMERNAME(AMERDFN) ; ROUTINE TO UPDATE PATIENT DATA IF PATCH 2 OF PATIENT REG 7.1 IS NOT INSTALLED
N DIC,AMERONAM
S DFN=AMERDFN
S AMERONAM=$P($G(^DPT(DFN,0)),U,1)
D CHKRHI^AG
I $D(RHIFLAG) D
. I RHIFLAG="A" W !,$$S^AGVDF("RVN"),$$S^AGVDF("BLN"),"This patient has Restricted Health Information",$$S^AGVDF("BLF"),$$S^AGVDF("RVF")
;ADD ALERT IF PATIENT HAS 'DATE OF DEATH' POPULATED IN VA PATIENT FILE
I $D(DFN) I $$CHKDEATH^AGEDERR(DFN) W !!?5,"**** ALERT: DATE OF DEATH ON FILE FOR THIS PATIENT!!" H 2
Q:'$D(DFN)
S DIR(0)="FOr^1:80",DIR("A")="ENTER NEW NAME",DIR("?")="ENTER NAME THAT SHOULD BE ON THIS RECORD(80 characters max.)"
S DIR("B")=AMERONAM
D ^DIR K DIR
I $D(DUOUT)!$D(DTOUT)!(Y="") K DUOUT,DTOUT,Y Q 0
Q:Y=AMERONAM 0
K AG("NEWNAME")
S X=Y
S AG("NEWNAME")=Y
D NAME^AUPNPED
I '$D(X) D EN^DDIOL("INCORRECT NAME FORMAT","","!!") K AG("NEWNAME") Q 0
S AG("OLDNAME")=AMERONAM
D NOW^%DTC S AGDTS=%
D ADDNAM^AGNAMCHG
Q:$D(AG("NAMFAIL")) 0
K DIC,DIE,DA,DR,Y
S DA=DFN
S DR=".01///"_AG("NEWNAME")
S X=$$DIEDPT(DA,DR)
I $P(^DPT(DFN,0),U)=AG("OLDNAME") D END Q 1
S AMERHL7="AGHL7"
S ^XTMP(AMERHL7,DA)=DA
S AMERH7AG="AGHL7AG"
S ^XTMP(AMERH7AG,DA,"UPDATE")=""
S DIR("A")="Do you wish to store "_AG("OLDNAME")_" in the ""OTHER NAMES"" file for future reference to this patient"
S DIR(0)="Y",DIR("B")="YES"
D ^DIR
I $D(DUOUT)!$D(DTOUT)!(Y="") K DUOUT,DTOUT,Y Q 0
I Y["Y" D
.S DIE="^DPT("
.S DA=DFN,DR="1///"_AG("OLDNAME"),DR(2,2.01)=.01
.S X=$$DIEDPT(DA,DR)
S ^AGPATCH(AGDTS,DUZ(2),DFN)="",DR=".03///TODAY",$P(^AUPNPAT(DFN,0),U,12)=DUZ,DA=DFN
D DIEAUPN(DA,DR)
Q 1
END ;
I '$G(AGTDS) S X="NOW" D ^%DT S AGDTS=Y
I $G(AGPTPG)=0,("N"'[($P(^AUTTSITE(1,0),"^",16))) S ^AGPATCH(AGDTS,DUZ(2),DFN,"ZMFI",0)=""
I $D(^AGPATCH(AGDTS,DUZ(2),DFN))=10 S ^AGPATCH(AGDTS,DUZ(2),DFN)=""
I $D(^AGPATCH(AGDTS,DUZ(2),DFN))=0 S ^AGPATCH(AGDTS,DUZ(2),DFN)=""
K AGDTS
Q
DIEDPT(DA,DR) ; GIVEN AN ENTRY NUMBER AND A DR STRING, EDIT THE VA PATIENT FILE
N X,Y,%
N D,D0,DI,DIC,DICR,DIE,DIG,DIH,DIV,DIU,DIW,DQ
S DIE="^DPT("
L +^DPT(DA):3 E Q
D ^DIE
L -^DPT(DA)
K DIE,DA,DR
Q X
DIEAUPN(DA,DR) ; GIVEN AN ENTRY NUMBER AND A DR STRING, EDIT THE PATIENT FILE
N X,Y,%
N D,D0,DI,DIC,DICR,DIE,DIG,DIH,DIV,DIU,DIW,DQ
S DIE="^AUPNPAT("
L +^AUPNPAT:3 E Q
D ^DIE
L -^AUPNPAT
K DIE,DA,DR
Q
AMERAGED ; IHS/OIT/SCR 06/22/06 - PATIENT REG ROUTINES
+1 ;;3.0;ER VISIT SYSTEM;;FEB 23, 2009
+2 ;
+3 ;;
NAME(AMERDFN) ; EP - From UPDATPAT^AMERVSIT
+1 ; Check for PATIENT REG 7.1 PATCH 2
+2 ; IF IT IS THERE RETURN VALUE FROM PATIENT REG API NAME^AGMANERS().
+3 ; IF NOT, RETURN VALUE FROM AMERNAME() BELOW
+4 ; Check for "AG" version 7.1 PATCH 1
+5 NEW AMERPTCH,AMERAGPT,AMERPNTR,AMEROK,AMERAGV,AMERRTRN
+6 SET AMERRTRN=""
+7 SET AMERAGV=$$VERSION^XPDUTL("AG")
+8 ;IF Patient Reg Version is not 7.1, dont' look for patch 2
IF AMERAGV'="7.1"
SET AMERRTRN=$$AMERNAME(AMERDFN)
QUIT AMERRTRN
+9 SET AMERPNTR=$ORDER(^DIC(9.4,"C","AG",0))
+10 SET AMERPTCH=0
SET AMEROK="NO"
+11 FOR
SET AMERPTCH=$ORDER(^DIC(9.4,AMERPNTR,22,AMERPTCH))
IF AMERPTCH=""!(AMEROK="YES")
QUIT
Begin DoDot:1
+12 ;ONLY LOOK AT ENTRIES FOR VERSION 7.1
IF $PIECE($GET(^DIC(9.4,AMERPNTR,22,AMERPTCH,0)),U,1)'="7.1"
QUIT
+13 SET AMERAGPT=""
+14 FOR
SET AMERAGPT=$ORDER(^DIC(9.4,AMERPNTR,22,AMERPTCH,"PAH",AMERAGPT))
IF (AMERAGPT=""!(AMEROK="YES"))
QUIT
Begin DoDot:2
+15 IF +$GET(^DIC(9.4,AMERPNTR,22,AMERPTCH,"PAH",AMERAGPT,0))[2
SET AMEROK="YES"
+16 QUIT
End DoDot:2
+17 QUIT
End DoDot:1
+18 IF AMEROK="YES"
SET AMERRTN=$$NAME^AGMANERS(AMERDFN)
+19 IF AMEROK'="YES"
SET AMERRTN=$$AMERNAME(AMERDFN)
+20 QUIT AMERRTN
+21 ;
+22 ; All of the following code will be replaced by NAME^AGMANERS when AG*7.1*2 IS RELEASED
AMERNAME(AMERDFN) ; ROUTINE TO UPDATE PATIENT DATA IF PATCH 2 OF PATIENT REG 7.1 IS NOT INSTALLED
+1 NEW DIC,AMERONAM
+2 SET DFN=AMERDFN
+3 SET AMERONAM=$PIECE($GET(^DPT(DFN,0)),U,1)
+4 DO CHKRHI^AG
+5 IF $DATA(RHIFLAG)
Begin DoDot:1
+6 IF RHIFLAG="A"
WRITE !,$$S^AGVDF("RVN"),$$S^AGVDF("BLN"),"This patient has Restricted Health Information",$$S^AGVDF("BLF"),$$S^AGVDF("RVF")
End DoDot:1
+7 ;ADD ALERT IF PATIENT HAS 'DATE OF DEATH' POPULATED IN VA PATIENT FILE
+8 IF $DATA(DFN)
IF $$CHKDEATH^AGEDERR(DFN)
WRITE !!?5,"**** ALERT: DATE OF DEATH ON FILE FOR THIS PATIENT!!"
HANG 2
+9 IF '$DATA(DFN)
QUIT
+10 SET DIR(0)="FOr^1:80"
SET DIR("A")="ENTER NEW NAME"
SET DIR("?")="ENTER NAME THAT SHOULD BE ON THIS RECORD(80 characters max.)"
+11 SET DIR("B")=AMERONAM
+12 DO ^DIR
KILL DIR
+13 IF $DATA(DUOUT)!$DATA(DTOUT)!(Y="")
KILL DUOUT,DTOUT,Y
QUIT 0
+14 IF Y=AMERONAM
QUIT 0
+15 KILL AG("NEWNAME")
+16 SET X=Y
+17 SET AG("NEWNAME")=Y
+18 DO NAME^AUPNPED
+19 IF '$DATA(X)
DO EN^DDIOL("INCORRECT NAME FORMAT","","!!")
KILL AG("NEWNAME")
QUIT 0
+20 SET AG("OLDNAME")=AMERONAM
+21 DO NOW^%DTC
SET AGDTS=%
+22 DO ADDNAM^AGNAMCHG
+23 IF $DATA(AG("NAMFAIL"))
QUIT 0
+24 KILL DIC,DIE,DA,DR,Y
+25 SET DA=DFN
+26 SET DR=".01///"_AG("NEWNAME")
+27 SET X=$$DIEDPT(DA,DR)
+28 IF $PIECE(^DPT(DFN,0),U)=AG("OLDNAME")
DO END
QUIT 1
+29 SET AMERHL7="AGHL7"
+30 SET ^XTMP(AMERHL7,DA)=DA
+31 SET AMERH7AG="AGHL7AG"
+32 SET ^XTMP(AMERH7AG,DA,"UPDATE")=""
+33 SET DIR("A")="Do you wish to store "_AG("OLDNAME")_" in the ""OTHER NAMES"" file for future reference to this patient"
+34 SET DIR(0)="Y"
SET DIR("B")="YES"
+35 DO ^DIR
+36 IF $DATA(DUOUT)!$DATA(DTOUT)!(Y="")
KILL DUOUT,DTOUT,Y
QUIT 0
+37 IF Y["Y"
Begin DoDot:1
+38 SET DIE="^DPT("
+39 SET DA=DFN
SET DR="1///"_AG("OLDNAME")
SET DR(2,2.01)=.01
+40 SET X=$$DIEDPT(DA,DR)
End DoDot:1
+41 SET ^AGPATCH(AGDTS,DUZ(2),DFN)=""
SET DR=".03///TODAY"
SET $PIECE(^AUPNPAT(DFN,0),U,12)=DUZ
SET DA=DFN
+42 DO DIEAUPN(DA,DR)
+43 QUIT 1
END ;
+1 IF '$GET(AGTDS)
SET X="NOW"
DO ^%DT
SET AGDTS=Y
+2 IF $GET(AGPTPG)=0
IF ("N"'[($PIECE(^AUTTSITE(1,0),"^",16)))
SET ^AGPATCH(AGDTS,DUZ(2),DFN,"ZMFI",0)=""
+3 IF $DATA(^AGPATCH(AGDTS,DUZ(2),DFN))=10
SET ^AGPATCH(AGDTS,DUZ(2),DFN)=""
+4 IF $DATA(^AGPATCH(AGDTS,DUZ(2),DFN))=0
SET ^AGPATCH(AGDTS,DUZ(2),DFN)=""
+5 KILL AGDTS
+6 QUIT
DIEDPT(DA,DR) ; GIVEN AN ENTRY NUMBER AND A DR STRING, EDIT THE VA PATIENT FILE
+1 NEW X,Y,%
+2 NEW D,D0,DI,DIC,DICR,DIE,DIG,DIH,DIV,DIU,DIW,DQ
+3 SET DIE="^DPT("
+4 LOCK +^DPT(DA):3
IF '$TEST
QUIT
+5 DO ^DIE
+6 LOCK -^DPT(DA)
+7 KILL DIE,DA,DR
+8 QUIT X
DIEAUPN(DA,DR) ; GIVEN AN ENTRY NUMBER AND A DR STRING, EDIT THE PATIENT FILE
+1 NEW X,Y,%
+2 NEW D,D0,DI,DIC,DICR,DIE,DIG,DIH,DIV,DIU,DIW,DQ
+3 SET DIE="^AUPNPAT("
+4 LOCK +^AUPNPAT:3
IF '$TEST
QUIT
+5 DO ^DIE
+6 LOCK -^AUPNPAT
+7 KILL DIE,DA,DR
+8 QUIT
