AMHDLOG.m

AMHDLOG ; IHS/CMI/LAB - driver for primary care provider report ;

 ;;4.0;IHS BEHAVIORAL HEALTH;;MAY 14, 2010

 ;

 W:$D(IOF) @IOF

 W !,"This report will display a list of who edited a BH record.",!!

 I '$G(DUZ(2)) W !!!,$C(7),$C(7),"SITE NOT SET IN YOUR USER PROFILE!  Please notify your Site Manager!" Q

 ;

 D GETDATE

 I AMHDATE="" W !!,"No Date entered!" D EOJ Q

 D GETLOC

 D GETPAT

 D RECLKUP

 I '$G(AMHR) D EOJ Q

 D DSPLY

 D EOJ

 Q

GETDATE ; GET DATE OF ENCOUNTER

 W !

 S AMHDATE=""

 S DIR(0)="DO^:"_DT_":EPT",DIR("A")="Enter ENCOUNTER DATE" D ^DIR K DIR S:$D(DUOUT) DIRUT=1

 Q:$D(DIRUT)

 S %DT="ET" D ^%DT G:Y<0 GETDATE

 I Y>DT W "  <Future dates not allowed>",$C(7),$C(7) K X G GETDATE

 K AMHODAT

 S AMHDATE=Y

 ;

 Q

GETPAT ; GET PATIENT

 S AMHPAT=""

 S DIC("A")="Enter PATIENT: ",DIC="^AUPNPAT(",DIC(0)="AEMQ" D ^DIC K DIC

 I Y<0 W !!,"no patient selected." Q

 S AMHPAT=+Y

 I $G(AUPNDOD)]"" W !!?10,"***** PATIENT'S DATE OF DEATH IS ",$$FMTE^XLFDT(AUPNDOD),!! H 2

 Q

 ;

GETLOC ;get location of encounter

 S AMHLOC=""

 S DIC("A")="Enter LOCATION OF ENCOUNTER (if known, otherwise press ENTER): ",DIC="^AUTTLOC(",DIC(0)="AEMQ" D ^DIC K DIC,DA

 Q:Y<0

 S AMHLOC=+Y

 Q

DSPLY ;

DIP ;

 S FLDS="[AMH DISPLAY LOG]",BY="@NUMBER",DIC="^AMHREC(",L=0

 S FR=AMHR,TO=AMHR

 K DHIT,DIOEND,DIOBEG

 D EN1^DIP

DONE ;

 S DIR(0)="EO",DIR("A")="End of report.  Press enter" D ^DIR K DIR S:$D(DUOUT) DIRUT=1 I $D(IOF) W @IOF

EOJ ;clean up

 K DIRUT,DUOUT,X,Y,DIR,FLDS,DIP,BY,TO,FR,DIC,DHD

 K AMHDATE,AMHLOC,AMHR,AMHRIEN,AMHPAT

 D KILL^AUPNPAT

 Q

 ;

RECLKUP ;

 D ^AMHRLKUP

 Q

AMHDLOG   ; IHS/CMI/LAB - driver for primary care provider report ;

 +1       ;;4.0;IHS BEHAVIORAL HEALTH;;MAY 14, 2010

 +2       ;

 +3        IF $DATA(IOF)

               WRITE @IOF

 +4        WRITE !,"This report will display a list of who edited a BH record.",!!

 +5        IF '$GET(DUZ(2))

               WRITE !!!,$CHAR(7),$CHAR(7),"SITE NOT SET IN YOUR USER PROFILE!  Please notify your Site Manager!"

               QUIT 

 +6       ;

 +7        DO GETDATE

 +8        IF AMHDATE=""

               WRITE !!,"No Date entered!"

               DO EOJ

               QUIT 

 +9        DO GETLOC

 +10       DO GETPAT

 +11       DO RECLKUP

 +12       IF '$GET(AMHR)

               DO EOJ

               QUIT 

 +13       DO DSPLY

 +14       DO EOJ

 +15       QUIT 

GETDATE   ; GET DATE OF ENCOUNTER

 +1        WRITE !

 +2        SET AMHDATE=""

 +3        SET DIR(0)="DO^:"_DT_":EPT"

           SET DIR("A")="Enter ENCOUNTER DATE"

           DO ^DIR

           KILL DIR

           IF $DATA(DUOUT)

               SET DIRUT=1

 +4        IF $DATA(DIRUT)

               QUIT 

 +5        SET %DT="ET"

           DO ^%DT

           IF Y<0

               GOTO GETDATE

 +6        IF Y>DT

               WRITE "  <Future dates not allowed>",$CHAR(7),$CHAR(7)

               KILL X

               GOTO GETDATE

 +7        KILL AMHODAT

 +8        SET AMHDATE=Y

 +9       ;

 +10       QUIT 

GETPAT    ; GET PATIENT

 +1        SET AMHPAT=""

 +2        SET DIC("A")="Enter PATIENT: "

           SET DIC="^AUPNPAT("

           SET DIC(0)="AEMQ"

           DO ^DIC

           KILL DIC

 +3        IF Y<0

               WRITE !!,"no patient selected."

               QUIT 

 +4        SET AMHPAT=+Y

 +5        IF $GET(AUPNDOD)]""

               WRITE !!?10,"***** PATIENT'S DATE OF DEATH IS ",$$FMTE^XLFDT(AUPNDOD),!!

               HANG 2

 +6        QUIT 

 +7       ;

GETLOC    ;get location of encounter

 +1        SET AMHLOC=""

 +2        SET DIC("A")="Enter LOCATION OF ENCOUNTER (if known, otherwise press ENTER): "

           SET DIC="^AUTTLOC("

           SET DIC(0)="AEMQ"

           DO ^DIC

           KILL DIC,DA

 +3        IF Y<0

               QUIT 

 +4        SET AMHLOC=+Y

 +5        QUIT 

DSPLY     ;

DIP       ;

 +1        SET FLDS="[AMH DISPLAY LOG]"

           SET BY="@NUMBER"

           SET DIC="^AMHREC("

           SET L=0

 +2        SET FR=AMHR

           SET TO=AMHR

 +3        KILL DHIT,DIOEND,DIOBEG

 +4        DO EN1^DIP

DONE      ;

 +1        SET DIR(0)="EO"

           SET DIR("A")="End of report.  Press enter"

           DO ^DIR

           KILL DIR

           IF $DATA(DUOUT)

               SET DIRUT=1

           IF $DATA(IOF)

               WRITE @IOF

EOJ       ;clean up

 +1        KILL DIRUT,DUOUT,X,Y,DIR,FLDS,DIP,BY,TO,FR,DIC,DHD

 +2        KILL AMHDATE,AMHLOC,AMHR,AMHRIEN,AMHPAT

 +3        DO KILL^AUPNPAT

 +4        QUIT 

 +5       ;

RECLKUP   ;

 +1        DO ^AMHRLKUP

 +2        QUIT