AGPHROPT.m

AGPHROPT ;IHS/OIT/NKD - EDIT ROUTINE FOR PHR FIELDS ; FEBRUARY 10, 2014

 ;;7.1;PATIENT REGISTRATION;**11**;AUG 25, 2005;Build 1

 ;

 ; THIS ROUTINE IS USED TO EDIT THE PHR FIELDS

 Q

EN ;EP - ENTRY THROUGH MENU OPTION

 N DFN

 D HDR^AG

 D PTLK^AG

 Q:'$D(DFN)

 D PHRA(DFN)

 Q

PHRA(DFN) ;EP - ENTRY OF PHR ACCESS FIELD

 N AGQUIT

 S AGQUIT=0

 F  Q:AGQUIT  D

 . N DIC,DA,DIE,DR,Y

 . S DA(1)=DFN

 . S DIC="^AUPNPAT("_DA(1)_",88,"

 . S DIC(0)="QEAL"

 . S DIC("DR")=""

 . D ^DIC

 . I Y=-1 S AGQUIT=1 Q

 . S DIE=DIC,DIE("NO^")="" K DIC

 . S DA=+Y

 . S DR=".01 Date of PHR Access;.02R~ Do you access your Personal Health Record?" D ^DIE

 Q

PHRH(DFN) ;EP - ENTRY OF PHR HANDOUT FIELD

 N AGQUIT

 S AGQUIT=0

 F  Q:AGQUIT  D

 . N DIC,DA,DIE,DR,Y

 . S DA(1)=DFN

 . S DIC="^AUPNPAT("_DA(1)_",89,"

 . S DIC(0)="QEAL"

 . S DIC("DR")=""

 . D ^DIC

 . I Y=-1 S AGQUIT=1 Q

 . S DIE=DIC,DIE("NO^")="" K DIC

 . S DA=+Y

 . S DR=".01 Date of PHR Handout;.02R~ Provided PHR handout?//YES" D ^DIE

 Q

PHRAP(DFN) ;EP - RETURNS LAST PHR ACCESS ENTRY IN DISPLAY FORMAT

 Q:'DFN ""

 N AGRES,AGLIEN

 S (AGRES,AGLIEN)=""

 S AGLIEN=$O(^AUPNPAT(DFN,88,"ACT",""),-1)

 I AGLIEN]"" D

 . S AGRES=$$GET1^DIQ(9000001.8801,AGLIEN_","_DFN_",",.02,"E")

 . S AGRES=AGRES_$J("",4-$L(AGRES))

 . S AGRES=AGRES_"("_$$GET1^DIQ(9000001.8801,AGLIEN_","_DFN_",",.01,"E")_")"

 Q AGRES

PHRHP(DFN) ;EP - RETURNS LAST PHR HANDOUT ENTRY IN DISPLAY FORMAT

 Q:'DFN ""

 N AGRES,AGLDT,AGLIEN

 S (AGRES,AGLDT,AGLIEN)=""

 S AGLDT=$O(^AUPNPAT(DFN,89,"B",""),-1)

 S:AGLDT]"" AGLIEN=$O(^AUPNPAT(DFN,89,"B",AGLDT,""))

 I AGLIEN]"" D

 . S AGRES=$$GET1^DIQ(9000001.8901,AGLIEN_","_DFN_",",.02,"E")

 . S AGRES=AGRES_$J("",4-$L(AGRES))

 . S AGRES=AGRES_"("_$$GET1^DIQ(9000001.8901,AGLIEN_","_DFN_",",.01,"E")_")"

 Q AGRES

AGPHROPT  ;IHS/OIT/NKD - EDIT ROUTINE FOR PHR FIELDS ; FEBRUARY 10, 2014

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

 +2       ;

 +3       ; THIS ROUTINE IS USED TO EDIT THE PHR FIELDS

 +4        QUIT 

EN        ;EP - ENTRY THROUGH MENU OPTION

 +1        NEW DFN

 +2        DO HDR^AG

 +3        DO PTLK^AG

 +4        IF '$DATA(DFN)

               QUIT 

 +5        DO PHRA(DFN)

 +6        QUIT 

PHRA(DFN) ;EP - ENTRY OF PHR ACCESS FIELD

 +1        NEW AGQUIT

 +2        SET AGQUIT=0

 +3        FOR 

               IF AGQUIT

                   QUIT 

               Begin DoDot:1

 +4                NEW DIC,DA,DIE,DR,Y

 +5                SET DA(1)=DFN

 +6                SET DIC="^AUPNPAT("_DA(1)_",88,"

 +7                SET DIC(0)="QEAL"

 +8                SET DIC("DR")=""

 +9                DO ^DIC

 +10               IF Y=-1

                       SET AGQUIT=1

                       QUIT 

 +11               SET DIE=DIC

                   SET DIE("NO^")=""

                   KILL DIC

 +12               SET DA=+Y

 +13               SET DR=".01 Date of PHR Access;.02R~ Do you access your Personal Health Record?"

                   DO ^DIE

               End DoDot:1

 +14       QUIT 

PHRH(DFN) ;EP - ENTRY OF PHR HANDOUT FIELD

 +1        NEW AGQUIT

 +2        SET AGQUIT=0

 +3        FOR 

               IF AGQUIT

                   QUIT 

               Begin DoDot:1

 +4                NEW DIC,DA,DIE,DR,Y

 +5                SET DA(1)=DFN

 +6                SET DIC="^AUPNPAT("_DA(1)_",89,"

 +7                SET DIC(0)="QEAL"

 +8                SET DIC("DR")=""

 +9                DO ^DIC

 +10               IF Y=-1

                       SET AGQUIT=1

                       QUIT 

 +11               SET DIE=DIC

                   SET DIE("NO^")=""

                   KILL DIC

 +12               SET DA=+Y

 +13               SET DR=".01 Date of PHR Handout;.02R~ Provided PHR handout?//YES"

                   DO ^DIE

               End DoDot:1

 +14       QUIT 

PHRAP(DFN) ;EP - RETURNS LAST PHR ACCESS ENTRY IN DISPLAY FORMAT

 +1        IF 'DFN

               QUIT ""

 +2        NEW AGRES,AGLIEN

 +3        SET (AGRES,AGLIEN)=""

 +4        SET AGLIEN=$ORDER(^AUPNPAT(DFN,88,"ACT",""),-1)

 +5        IF AGLIEN]""

               Begin DoDot:1

 +6                SET AGRES=$$GET1^DIQ(9000001.8801,AGLIEN_","_DFN_",",.02,"E")

 +7                SET AGRES=AGRES_$JUSTIFY("",4-$LENGTH(AGRES))

 +8                SET AGRES=AGRES_"("_$$GET1^DIQ(9000001.8801,AGLIEN_","_DFN_",",.01,"E")_")"

               End DoDot:1

 +9        QUIT AGRES

PHRHP(DFN) ;EP - RETURNS LAST PHR HANDOUT ENTRY IN DISPLAY FORMAT

 +1        IF 'DFN

               QUIT ""

 +2        NEW AGRES,AGLDT,AGLIEN

 +3        SET (AGRES,AGLDT,AGLIEN)=""

 +4        SET AGLDT=$ORDER(^AUPNPAT(DFN,89,"B",""),-1)

 +5        IF AGLDT]""

               SET AGLIEN=$ORDER(^AUPNPAT(DFN,89,"B",AGLDT,""))

 +6        IF AGLIEN]""

               Begin DoDot:1

 +7                SET AGRES=$$GET1^DIQ(9000001.8901,AGLIEN_","_DFN_",",.02,"E")

 +8                SET AGRES=AGRES_$JUSTIFY("",4-$LENGTH(AGRES))

 +9                SET AGRES=AGRES_"("_$$GET1^DIQ(9000001.8901,AGLIEN_","_DFN_",",.01,"E")_")"

               End DoDot:1

 +10       QUIT AGRES