AMHRDISP.m

AMHRDISP ; IHS/CMI/LAB - DISPLAY A RECORD (FILEMAN INQUIRE FORMAT) ;

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

 ;

 D GETDATE

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

 D GETLOC

 D GETPAT

 I $G(AMHIAMDE),AMHPAT="" W !!,"No patient selected." H 2 D EOJ Q

 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 (if known, otherwise press ENTER): ",DIC="^AUPNPAT(",DIC(0)="AEMQ"

 I $G(AMHIAMDE) S DIC("A")="Enter PATIENT NAME: "

 D ^DIC K DIC

 Q:Y<0

 S AMHPAT=+Y

 I '$$ALLOWP^AMHUTIL(DUZ,AMHPAT) D NALLOWP^AMHUTIL,PAUSE^AMHLEA S AMHPAT="" Q

 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 ;

 D ^AMHDVD

 Q

 ;

RECLKUP ;

 D ^AMHRLKUP

 Q

EOJ ; END OF JOB

 K AMHPROV,AMHDATE,AMHPAT,AMHODAT,AMHR

 Q

TEXT ;

 ;;BH Data Entry Module

 ;;

 ;;************************

 ;;* Update BH Visits *

 ;;************************

 ;;

 Q

 ;

AMHRDISP  ; IHS/CMI/LAB - DISPLAY A RECORD (FILEMAN INQUIRE FORMAT) ;

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

 +2       ;

 +3        DO GETDATE

 +4        IF AMHDATE=""

               WRITE !!,"No Date entered!"

               DO EOJ

               QUIT 

 +5        DO GETLOC

 +6        DO GETPAT

 +7        IF $GET(AMHIAMDE)

               IF AMHPAT=""

                   WRITE !!,"No patient selected."

                   HANG 2

                   DO EOJ

                   QUIT 

 +8        DO RECLKUP

 +9        IF '$GET(AMHR)

               DO EOJ

               QUIT 

 +10       DO DSPLY

 +11       DO EOJ

 +12       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 (if known, otherwise press ENTER): "

           SET DIC="^AUPNPAT("

           SET DIC(0)="AEMQ"

 +3        IF $GET(AMHIAMDE)

               SET DIC("A")="Enter PATIENT NAME: "

 +4        DO ^DIC

           KILL DIC

 +5        IF Y<0

               QUIT 

 +6        SET AMHPAT=+Y

 +7        IF '$$ALLOWP^AMHUTIL(DUZ,AMHPAT)

               DO NALLOWP^AMHUTIL

               DO PAUSE^AMHLEA

               SET AMHPAT=""

               QUIT 

 +8        IF $GET(AUPNDOD)]""

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

               HANG 2

 +9        QUIT 

 +10      ;

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     ;

 +1        DO ^AMHDVD

 +2        QUIT 

 +3       ;

RECLKUP   ;

 +1        DO ^AMHRLKUP

 +2        QUIT 

EOJ       ; END OF JOB

 +1        KILL AMHPROV,AMHDATE,AMHPAT,AMHODAT,AMHR

 +2        QUIT 

TEXT      ;

 +1       ;;BH Data Entry Module

 +2       ;;

 +3       ;;************************

 +4       ;;* Update BH Visits *

 +5       ;;************************

 +6       ;;

 +7        QUIT 

 +8       ;