- 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
