AMERAGED.m

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