AMHLEAR ; IHS/CMI/LAB - BH ACTIVITY RECORD LOG ENTRY ;
;;4.0;IHS BEHAVIORAL HEALTH;;MAY 14, 2010
;
;Activty Record Log data entry
D XIT
D ^AMHLEIN
D INFORM
K AMHPROV F D GETPROV Q:'$D(AMHPROV)
D END
D XIT
Q
GETPROV ;get providers
K AMHPROV S AMHC=0
K DIR,DA,DTOUT,DIRUT,DUOUT,DIC,X,Y S DIR(0)="9002011.02,.01O",DIR("A")="Enter PRIMARY PROVIDER" D ^DIR K DIR S:$D(DUOUT) DIRUT=1
I $D(DIRUT) Q
I Y="" Q
S AMHC=AMHC+1,AMHPROV(AMHC)=+Y,$P(AMHPROV(AMHC),U,2)=$S(AMHC=1:"P",1:"S")
GETPROG ;
S AMHPROG=""
K DIR,DA,DTOUT,DIRUT,DUOUT,DIC,X,Y S DIR(0)="SBO^M:Mental Health;S:Social Services;O:Other",DIR("A")="Enter PROGRAM" D ^DIR K DIR S:$D(DUOUT) DIRUT=1
G:$D(DIRUT) GETPROV
I Y="" G GETPROV
S AMHPROG=Y,AMHPROG(0)=Y(0)
GETLOC ; GET LOCATION OF ENCOUNTER
S AMHLOC="",DIC="^AUTTLOC(",DIC(0)="AEMQ" D ^DIC K DIC
G:Y<0 GETPROG
S AMHLOC=+Y
GETDATE ; GET DATE OF ENCOUNTER
S AMHDATE="",DIR(0)="DO^:"_DT_":EPT",DIR("A")="Enter ENCOUNTER DATE" D ^DIR K DIR S:$D(DUOUT) DIRUT=1
I $D(DIRUT) G GETLOC
I Y="" G GETLOC
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
;
GETCOMM ;
S AMHCOMM="",DIC(0)="AEMQ",DIC("A")="Enter COMMUNITY: ",DIC="^AUTTCOM(" D ^DIC K DIC,DA
I Y=-1 G GETDATE
S AMHCOMM=+Y
GETACT ;
S AMHACT="",DIR(0)="9002011,.06",DIR("A")="Enter ACTIVITY" D ^DIR K DIR S:$D(DUOUT) DIRUT=1
I $D(DIRUT) G GETCOMM
I $P(^AMHTACT(+Y,0),U,6)=1 W !!,$C(7),$C(7),?14,"**Enter Acceptable Activity Code (32-43, 51-59, 63-72, 83-84)**",!! G GETACT
S AMHACT=Y
I $P(^AMHTACT(+Y,0),U,6) W !,$C(7),$C(7),"Must be in the code range " G GETACT
GETNUM ;
S AMHNUM="",DIR(0)="9002011,.09",DIR("A")="Enter TOTAL NUMBER SERVED" D ^DIR K DIR S:$D(DUOUT) DIRUT=1
I $D(DIRUT) G GETACT
S AMHNUM=Y
GETTIME ;
S AMHTIME="",DIR(0)="9002011,.12",DIR("A")="Enter TOTAL ACTIVITY TIME" D ^DIR K DIR S:$D(DUOUT) DIRUT=1
I $D(DIRUT) G GETNUM
S AMHTIME=Y
GETCONT ;
S AMHCONT="",DIR(0)="9002011,.07",DIR("A")="Enter TYPE OF CONTACT" D ^DIR K DIR S:$D(DUOUT) DIRUT=1
I $D(DIRUT) G GETACT
S AMHCONT=Y,AMHCONT(0)=Y(0)
GETPOVS ;
K AMHPOV S AMHC=0
GETPOVS1 ;
K DIR,DA,DTOUT,DIRUT,DUOUT,DIC,X,Y S DIR(0)="9002011.01,.01",DIR("A")="Enter PROBLEM (POV)" D ^DIR K DIR S:$D(DUOUT) DIRUT=1
I $D(DIRUT),AMHC=0 G GETCONT
I Y="",AMHC=0 G GETCONT
S AMHPOVP=+Y
GETNARR ;
S AMHNARR=""
K DIR,DA,DTOUT,DIRUT,DUOUT,DIC,X,Y S DIR(0)="9000010.07,.04O",DIR("A")="Provider Narrative" D ^DIR K DIR S:$D(DUOUT) DIRUT=1
I Y="" S AMHNARR=$E($P(^AMHPROB(AMHPOVP,0),U,2),1,80) G SET
G:$D(DIRUT) GETPOVS1
S AMHNARR=$P(^AUTNPOV(+Y,0),U)
SET S AMHC=AMHC+1,AMHPOV(AMHC)=AMHPOVP_U_AMHNARR
CREATE D ^AMHLEAR1
Q
INFORM ;
W !!," *** ACTIVITY RECORD LOG Data Entry Option ***",!!
W " You will be prompted to enter all pertinent Record information",!," You will NOT be prompted to enter the Patient Names",!
W " .....Only the following ACTIVITY CODES are acceptable Entries.....",!
W !," **32-43**51-59**63-65*72**83-84**",!!
Q
END ;ending message
W !," ","......END OF ACTIVITY RECORD LOG DATA ENTRY......",!
Q
XIT ;CLEAN UP AND EXIT
K DIR,X,Y,DIC,DR,DA,D0,DO,DIZ,D
K AMHDATE,AMHLOC,AMHPROG,AMHPROV,AMHCOMM,AMHACT,AMHCONT,AMHPOVS,AMHPOVP,AMHC,AMHPOV,AMHNARR,AMHTIME,AMHNUM,AMHPOVP,AMHBEEP,AMHGOT,AMHLPCC,AMHVISIT,AMHLEGPI,AMHLEIN,AMHOKAY,AMHPAT,AMHQUIT,AMHREC,AMHDASH,AMHBT
K AMHR,AMHACTN
Q
AMHLEAR ; IHS/CMI/LAB - BH ACTIVITY RECORD LOG ENTRY ;
+1 ;;4.0;IHS BEHAVIORAL HEALTH;;MAY 14, 2010
+2 ;
+3 ;Activty Record Log data entry
+4 DO XIT
+5 DO ^AMHLEIN
+6 DO INFORM
+7 KILL AMHPROV
FOR
DO GETPROV
IF '$DATA(AMHPROV)
QUIT
+8 DO END
+9 DO XIT
+10 QUIT
GETPROV ;get providers
+1 KILL AMHPROV
SET AMHC=0
+2 KILL DIR,DA,DTOUT,DIRUT,DUOUT,DIC,X,Y
SET DIR(0)="9002011.02,.01O"
SET DIR("A")="Enter PRIMARY PROVIDER"
DO ^DIR
KILL DIR
IF $DATA(DUOUT)
SET DIRUT=1
+3 IF $DATA(DIRUT)
QUIT
+4 IF Y=""
QUIT
+5 SET AMHC=AMHC+1
SET AMHPROV(AMHC)=+Y
SET $PIECE(AMHPROV(AMHC),U,2)=$SELECT(AMHC=1:"P",1:"S")
GETPROG ;
+1 SET AMHPROG=""
+2 KILL DIR,DA,DTOUT,DIRUT,DUOUT,DIC,X,Y
SET DIR(0)="SBO^M:Mental Health;S:Social Services;O:Other"
SET DIR("A")="Enter PROGRAM"
DO ^DIR
KILL DIR
IF $DATA(DUOUT)
SET DIRUT=1
+3 IF $DATA(DIRUT)
GOTO GETPROV
+4 IF Y=""
GOTO GETPROV
+5 SET AMHPROG=Y
SET AMHPROG(0)=Y(0)
GETLOC ; GET LOCATION OF ENCOUNTER
+1 SET AMHLOC=""
SET DIC="^AUTTLOC("
SET DIC(0)="AEMQ"
DO ^DIC
KILL DIC
+2 IF Y<0
GOTO GETPROG
+3 SET AMHLOC=+Y
GETDATE ; GET DATE OF ENCOUNTER
+1 SET AMHDATE=""
SET DIR(0)="DO^:"_DT_":EPT"
SET DIR("A")="Enter ENCOUNTER DATE"
DO ^DIR
KILL DIR
IF $DATA(DUOUT)
SET DIRUT=1
+2 IF $DATA(DIRUT)
GOTO GETLOC
+3 IF Y=""
GOTO GETLOC
+4 SET %DT="ET"
DO ^%DT
IF Y<0
GOTO GETDATE
+5 IF Y>DT
WRITE " <Future dates not allowed>",$CHAR(7),$CHAR(7)
KILL X
GOTO GETDATE
+6 SET AMHDATE=Y
+7 ;
GETCOMM ;
+1 SET AMHCOMM=""
SET DIC(0)="AEMQ"
SET DIC("A")="Enter COMMUNITY: "
SET DIC="^AUTTCOM("
DO ^DIC
KILL DIC,DA
+2 IF Y=-1
GOTO GETDATE
+3 SET AMHCOMM=+Y
GETACT ;
+1 SET AMHACT=""
SET DIR(0)="9002011,.06"
SET DIR("A")="Enter ACTIVITY"
DO ^DIR
KILL DIR
IF $DATA(DUOUT)
SET DIRUT=1
+2 IF $DATA(DIRUT)
GOTO GETCOMM
+3 IF $PIECE(^AMHTACT(+Y,0),U,6)=1
WRITE !!,$CHAR(7),$CHAR(7),?14,"**Enter Acceptable Activity Code (32-43, 51-59, 63-72, 83-84)**",!!
GOTO GETACT
+4 SET AMHACT=Y
+5 IF $PIECE(^AMHTACT(+Y,0),U,6)
WRITE !,$CHAR(7),$CHAR(7),"Must be in the code range "
GOTO GETACT
GETNUM ;
+1 SET AMHNUM=""
SET DIR(0)="9002011,.09"
SET DIR("A")="Enter TOTAL NUMBER SERVED"
DO ^DIR
KILL DIR
IF $DATA(DUOUT)
SET DIRUT=1
+2 IF $DATA(DIRUT)
GOTO GETACT
+3 SET AMHNUM=Y
GETTIME ;
+1 SET AMHTIME=""
SET DIR(0)="9002011,.12"
SET DIR("A")="Enter TOTAL ACTIVITY TIME"
DO ^DIR
KILL DIR
IF $DATA(DUOUT)
SET DIRUT=1
+2 IF $DATA(DIRUT)
GOTO GETNUM
+3 SET AMHTIME=Y
GETCONT ;
+1 SET AMHCONT=""
SET DIR(0)="9002011,.07"
SET DIR("A")="Enter TYPE OF CONTACT"
DO ^DIR
KILL DIR
IF $DATA(DUOUT)
SET DIRUT=1
+2 IF $DATA(DIRUT)
GOTO GETACT
+3 SET AMHCONT=Y
SET AMHCONT(0)=Y(0)
GETPOVS ;
+1 KILL AMHPOV
SET AMHC=0
GETPOVS1 ;
+1 KILL DIR,DA,DTOUT,DIRUT,DUOUT,DIC,X,Y
SET DIR(0)="9002011.01,.01"
SET DIR("A")="Enter PROBLEM (POV)"
DO ^DIR
KILL DIR
IF $DATA(DUOUT)
SET DIRUT=1
+2 IF $DATA(DIRUT)
IF AMHC=0
GOTO GETCONT
+3 IF Y=""
IF AMHC=0
GOTO GETCONT
+4 SET AMHPOVP=+Y
GETNARR ;
+1 SET AMHNARR=""
+2 KILL DIR,DA,DTOUT,DIRUT,DUOUT,DIC,X,Y
SET DIR(0)="9000010.07,.04O"
SET DIR("A")="Provider Narrative"
DO ^DIR
KILL DIR
IF $DATA(DUOUT)
SET DIRUT=1
+3 IF Y=""
SET AMHNARR=$EXTRACT($PIECE(^AMHPROB(AMHPOVP,0),U,2),1,80)
GOTO SET
+4 IF $DATA(DIRUT)
GOTO GETPOVS1
+5 SET AMHNARR=$PIECE(^AUTNPOV(+Y,0),U)
SET SET AMHC=AMHC+1
SET AMHPOV(AMHC)=AMHPOVP_U_AMHNARR
CREATE DO ^AMHLEAR1
+1 QUIT
INFORM ;
+1 WRITE !!," *** ACTIVITY RECORD LOG Data Entry Option ***",!!
+2 WRITE " You will be prompted to enter all pertinent Record information",!," You will NOT be prompted to enter the Patient Names",!
+3 WRITE " .....Only the following ACTIVITY CODES are acceptable Entries.....",!
+4 WRITE !," **32-43**51-59**63-65*72**83-84**",!!
+5 QUIT
END ;ending message
+1 WRITE !," ","......END OF ACTIVITY RECORD LOG DATA ENTRY......",!
+2 QUIT
XIT ;CLEAN UP AND EXIT
+1 KILL DIR,X,Y,DIC,DR,DA,D0,DO,DIZ,D
+2 KILL AMHDATE,AMHLOC,AMHPROG,AMHPROV,AMHCOMM,AMHACT,AMHCONT,AMHPOVS,AMHPOVP,AMHC,AMHPOV,AMHNARR,AMHTIME,AMHNUM,AMHPOVP,AMHBEEP,AMHGOT,AMHLPCC,AMHVISIT,AMHLEGPI,AMHLEIN,AMHOKAY,AMHPAT,AMHQUIT,AMHREC,AMHDASH,AMHBT
+3 KILL AMHR,AMHACTN
+4 QUIT
