- 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
