AMHLEPAT.m

AMHLEPAT ; IHS/CMI/LAB - UPDATE PATIENT RELATED DATA ;

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

 ;

 ;

 ;

 D START

 D ^AMHEKL

 K AMHLOC,AMHPAT,AMHDATE,AMHACTN,AMHAUTH,AMHSELS,AMHMHPL,AMHNONE,AMHOTH,AMHHIGH,AMHLOOK

 D KILL^AUPNPAT

 Q

START ;

 D ^AMHLEIN

 S AMHACTN=9

 D GETPAT Q:'$G(AMHPAT)

 D GETLOC Q:'$G(AMHLOC)

 D GETDATE Q:'$G(AMHDATE)

 D GETPROV Q:$G(AMHAUTH)=""

 D OTHER^AMHLEA

 Q

GETPAT ;

 W !

 S DIC="^AUPNPAT(",DIC(0)="AEMQ" D ^DIC K DIC

 Q:Y<0

 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="",DIC="^AUTTLOC(",DIC(0)="AEMQ" D ^DIC K DIC

 Q:Y<0

 S AMHLOC=+Y

 Q

 ;

GETDATE ; GET DATE OF ENCOUNTER

 ;

 S AMHDATE=""

 S DIR(0)="DO^:"_DT_":EPT",DIR("A")="Enter DATE NOTED" 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

 S AMHDATE=Y

 ;

 Q

GETPROV ;get provider/author for notes

 S AMHAUTH=""

 S DIR(0)="9002011.02,.01",DIR("A")="Enter PROVIDER" D ^DIR K DIR S:$D(DUOUT) DIRUT=1

 Q:$D(DIRUT)

 S AMHAUTH=$P(^VA(200,+Y,0),U)

 Q

AMHLEPAT  ; IHS/CMI/LAB - UPDATE PATIENT RELATED DATA ;

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

 +2       ;

 +3       ;

 +4       ;

 +5        DO START

 +6        DO ^AMHEKL

 +7        KILL AMHLOC,AMHPAT,AMHDATE,AMHACTN,AMHAUTH,AMHSELS,AMHMHPL,AMHNONE,AMHOTH,AMHHIGH,AMHLOOK

 +8        DO KILL^AUPNPAT

 +9        QUIT 

START     ;

 +1        DO ^AMHLEIN

 +2        SET AMHACTN=9

 +3        DO GETPAT

           IF '$GET(AMHPAT)

               QUIT 

 +4        DO GETLOC

           IF '$GET(AMHLOC)

               QUIT 

 +5        DO GETDATE

           IF '$GET(AMHDATE)

               QUIT 

 +6        DO GETPROV

           IF $GET(AMHAUTH)=""

               QUIT 

 +7        DO OTHER^AMHLEA

 +8        QUIT 

GETPAT    ;

 +1        WRITE !

 +2        SET DIC="^AUPNPAT("

           SET DIC(0)="AEMQ"

           DO ^DIC

           KILL DIC

 +3        IF Y<0

               QUIT 

 +4        SET AMHPAT=+Y

 +5        IF $GET(AUPNDOD)]""

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

               HANG 2

 +6        QUIT 

GETLOC    ; GET LOCATION OF ENCOUNTER

 +1        SET AMHLOC=""

           SET DIC="^AUTTLOC("

           SET DIC(0)="AEMQ"

           DO ^DIC

           KILL DIC

 +2        IF Y<0

               QUIT 

 +3        SET AMHLOC=+Y

 +4        QUIT 

 +5       ;

GETDATE   ; GET DATE OF ENCOUNTER

 +1       ;

 +2        SET AMHDATE=""

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

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

           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        SET AMHDATE=Y

 +8       ;

 +9        QUIT 

GETPROV   ;get provider/author for notes

 +1        SET AMHAUTH=""

 +2        SET DIR(0)="9002011.02,.01"

           SET DIR("A")="Enter PROVIDER"

           DO ^DIR

           KILL DIR

           IF $DATA(DUOUT)

               SET DIRUT=1

 +3        IF $DATA(DIRUT)

               QUIT 

 +4        SET AMHAUTH=$PIECE(^VA(200,+Y,0),U)

 +5        QUIT