APCDCAF4.m

APCDCAF4 ; IHS/CMI/LAB - MENTAL HLTH ROUTINE 16-AUG-1994 ;

 ;;2.0;IHS PCC SUITE;**7,11**;MAY 14, 2009;Build 58

 ;; ;

 ;

DISP ;EP

 D FULL^VALM1

 D EN^XBNEW("DISP1^APCDCAF4","VALM*;APCDCAFP;APCDCAFO;APCDDFN")

 ;

 ;

DISPX ;

 K DIR,DIRUT,DUOUT,Y,APCDVSIT,APCDCAF,APCDCAFV

 D KILL^AUPNPAT

 D BACK^APCDCAF

 Q

DISP1 ;

 I $G(APCDCAFO) S APCDPAT=APCDDFN D  Q

 .D GETVISIT^APCDDISP

 .I '$G(APCDVSIT) W !!,"No visit selected." D PAUSE^APCDALV1 Q

 .D DSPLY^APCDDISP

 .D PAUSE^APCDALV1 Q

 D ^APCDDISP

 D PAUSE^APCDALV1

 Q

DISPO ;EP

 NEW APCDCAFO

 S APCDCAFO=1

 D DISP

 Q

RN ;EP

 D FULL^VALM1

 W !!,"You will be prompted to enter a Patient Name and visit date and then"

 W !,"will be given the opportunity to edit the chart audit note or completely"

 W !,"delete the note.",!

 D EN^XBNEW("RN1^APCDCAF4","VALM*;APCDCAFP;APCDCAFO;APCDDFN")

 ;

 ;

RNX ;

 K DIR,DIRUT,DUOUT,Y,APCDVSIT,APCDCAF,APCDCAFV

 D KILL^AUPNPAT

 D BACK^APCDCAF

 Q

RN1 ;

 I $G(APCDCAFO) S APCDPAT=APCDDFN D  Q

 .D GETVISIT^APCDDISP

 .I '$G(APCDVSIT) W !!,"No visit selected." D PAUSE^APCDALV1 Q

 .D DSPLY^APCDDISP

 .D PAUSE^APCDALV1 Q

 D GETPAT^APCDDISP

 I APCDPAT="" W !!,"No PATIENT selected!" Q

 D GETVISIT^APCDDISP

 I APCDVSIT="" W !!,"No VISIT selected!" Q

 Q

RNU ;EP 

 ;edit note or remove note

 I '$D(^AUPNCANT("B",APCDVSIT)) Q

 W !!,"Chart Audit Notes for this visit: ",!

 I '$D(^AUPNCANT("B",APCDVSIT)) W !!?4,"There are no Chart Audit Notes on file for this visit.",! D PAUSE^APCDALV1 Q

 S X=0 F  S X=$O(^AUPNCANT(APCDVSIT,11,X)) Q:X'=+X  W !,^AUPNCANT(APCDVSIT,11,X,0)

 W !

 D PAUSE^APCDALV1

 S DIR(0)="S^D:Delete the Chart Audit Notes from this visit;E:Edit the Chart Audit Notes;Q:No Audit Note Change",DIR("A")="Choose Action",DIR("B")="Q" KILL DA D ^DIR KILL DIR

 I $D(DIRUT) D PAUSE^APCDALV1 Q

 I Y="E" S DIE="^AUPNCANT(",DR=1100,DA=APCDVSIT D ^DIE K DIE,DA,DR D PAUSE^APCDALV1 Q

 I Y="D" K ^AUPNCANT(APCDVSIT,11) W !!,"Notes removed." D PAUSE^APCDALV1 Q  ;kill off word processing field

 Q

RNO ;EP

 NEW APCDCAFO

 S APCDCAFO=1

 D RN

 Q

APCDCAF4  ; IHS/CMI/LAB - MENTAL HLTH ROUTINE 16-AUG-1994 ;

 +1       ;;2.0;IHS PCC SUITE;**7,11**;MAY 14, 2009;Build 58

 +2       ;; ;

 +3       ;

DISP      ;EP

 +1        DO FULL^VALM1

 +2        DO EN^XBNEW("DISP1^APCDCAF4","VALM*;APCDCAFP;APCDCAFO;APCDDFN")

 +3       ;

 +4       ;

DISPX     ;

 +1        KILL DIR,DIRUT,DUOUT,Y,APCDVSIT,APCDCAF,APCDCAFV

 +2        DO KILL^AUPNPAT

 +3        DO BACK^APCDCAF

 +4        QUIT 

DISP1     ;

 +1        IF $GET(APCDCAFO)

               SET APCDPAT=APCDDFN

               Begin DoDot:1

 +2                DO GETVISIT^APCDDISP

 +3                IF '$GET(APCDVSIT)

                       WRITE !!,"No visit selected."

                       DO PAUSE^APCDALV1

                       QUIT 

 +4                DO DSPLY^APCDDISP

 +5                DO PAUSE^APCDALV1

                   QUIT 

               End DoDot:1

               QUIT 

 +6        DO ^APCDDISP

 +7        DO PAUSE^APCDALV1

 +8        QUIT 

DISPO     ;EP

 +1        NEW APCDCAFO

 +2        SET APCDCAFO=1

 +3        DO DISP

 +4        QUIT 

RN        ;EP

 +1        DO FULL^VALM1

 +2        WRITE !!,"You will be prompted to enter a Patient Name and visit date and then"

 +3        WRITE !,"will be given the opportunity to edit the chart audit note or completely"

 +4        WRITE !,"delete the note.",!

 +5        DO EN^XBNEW("RN1^APCDCAF4","VALM*;APCDCAFP;APCDCAFO;APCDDFN")

 +6       ;

 +7       ;

RNX       ;

 +1        KILL DIR,DIRUT,DUOUT,Y,APCDVSIT,APCDCAF,APCDCAFV

 +2        DO KILL^AUPNPAT

 +3        DO BACK^APCDCAF

 +4        QUIT 

RN1       ;

 +1        IF $GET(APCDCAFO)

               SET APCDPAT=APCDDFN

               Begin DoDot:1

 +2                DO GETVISIT^APCDDISP

 +3                IF '$GET(APCDVSIT)

                       WRITE !!,"No visit selected."

                       DO PAUSE^APCDALV1

                       QUIT 

 +4                DO DSPLY^APCDDISP

 +5                DO PAUSE^APCDALV1

                   QUIT 

               End DoDot:1

               QUIT 

 +6        DO GETPAT^APCDDISP

 +7        IF APCDPAT=""

               WRITE !!,"No PATIENT selected!"

               QUIT 

 +8        DO GETVISIT^APCDDISP

 +9        IF APCDVSIT=""

               WRITE !!,"No VISIT selected!"

               QUIT 

 +10       QUIT 

RNU       ;EP 

 +1       ;edit note or remove note

 +2        IF '$DATA(^AUPNCANT("B",APCDVSIT))

               QUIT 

 +3        WRITE !!,"Chart Audit Notes for this visit: ",!

 +4        IF '$DATA(^AUPNCANT("B",APCDVSIT))

               WRITE !!?4,"There are no Chart Audit Notes on file for this visit.",!

               DO PAUSE^APCDALV1

               QUIT 

 +5        SET X=0

           FOR 

               SET X=$ORDER(^AUPNCANT(APCDVSIT,11,X))

               IF X'=+X

                   QUIT 

               WRITE !,^AUPNCANT(APCDVSIT,11,X,0)

 +6        WRITE !

 +7        DO PAUSE^APCDALV1

 +8        SET DIR(0)="S^D:Delete the Chart Audit Notes from this visit;E:Edit the Chart Audit Notes;Q:No Audit Note Change"

           SET DIR("A")="Choose Action"

           SET DIR("B")="Q"

           KILL DA

           DO ^DIR

           KILL DIR

 +9        IF $DATA(DIRUT)

               DO PAUSE^APCDALV1

               QUIT 

 +10       IF Y="E"

               SET DIE="^AUPNCANT("

               SET DR=1100

               SET DA=APCDVSIT

               DO ^DIE

               KILL DIE,DA,DR

               DO PAUSE^APCDALV1

               QUIT 

 +11      ;kill off word processing field

           IF Y="D"

               KILL ^AUPNCANT(APCDVSIT,11)

               WRITE !!,"Notes removed."

               DO PAUSE^APCDALV1

               QUIT 

 +12       QUIT 

RNO       ;EP

 +1        NEW APCDCAFO

 +2        SET APCDCAFO=1

 +3        DO RN

 +4        QUIT