AMHLEA2.m

AMHLEA2 ; IHS/CMI/LAB - ADD NEW CHR ACTIVITY RECORDS ;

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

 ;

 ;add new records

 ;get all items for a record, check record, file record

 ;if not complete record, issue warning and delete record

BEGIN ;add adm record

 W:$D(IOF) @IOF

 W !!,"Update Case Tracking Visit Record",!

 D GETTYPE

 I AMHPTYPE="" D EXIT Q

 D GETDATE

 I AMHDATE="" D EXIT Q

 D CREATE

 D EXIT

 Q

GETTYPE ;EP

 S AMHPTYPE=""

 S DIR(0)="S^M:MENTAL HEALTH DEFAULTS;S:SOCIAL SERVICES DEFAULTS;C:CHEMICAL DEPENDENCY or ALCOHOL/SUBSTANCE ABUSE;O:OTHER",DIR("A")="Which set of defaults do you want to use in Data Entry" K DA D ^DIR K DIR

 Q:$D(DIRUT)

 S AMHPTYPE=Y

 Q

GETDATE ;EP - GET DATE OF ENCOUNTER

 W !!

 S AMHDATE="",DIR(0)="DO^:"_DT_":EPTX",DIR("A")="Enter ENCOUNTER DATE" D ^DIR K DIR S:$D(DUOUT) DIRUT=1

 Q:$D(DIRUT)

 S AMHDATE=Y

 Q

CREATE ;EP

 S AMHACTN=1

 S APCDOVRR=""

 D GETPAT

 I '$G(AMHPAT) W !!,"No Patient Selected." D EXIT Q

 K DD,D0,DO,DINUM,DIC,DA,DR S DIC(0)="EL",DIC="^AMHREC(",DLAYGO=9002011,DIADD=1,X=AMHDATE,DIC("DR")=".03////"_DUZ_";.19////"_DT_";.21////"_DT_";.22////A;.08////"_$G(AMHPAT)_";1111////1" D FILE^DICN K DIC,DR,DIE,DIADD,DLAYGO,X,D0

 I Y=-1 W !!,$C(7),$C(7),"Behavioral Health Record is NOT complete!!  Deleting Record.",! D PAUSE Q

 S AMHR=+Y,DIE="^AMHREC(",DA=AMHR,DR="5100///NOW",DR(2,9002011.5101)=".02////^S X=DUZ" D ^DIE K DIE,DA,DR

 D GETPROV

 S DA=AMHR,DDSFILE=9002011,DR="[AMH ADD CASE TRACKING REC]" D ^DDS

 I $D(DIMSG) W !!,"ERROR IN SCREENMAN FORM!!  ***NOTIFY PROGRAMMER***" S AMHQUIT=1 K DIMSG Q

 I '$D(^AMHRPRO("AD",AMHR))!('$D(^AMHRPROV("AD",AMHR))) W !!,"Incomplete record!! Deleting record!!" D DEL G EXIT

 S AMHOKAY=0 D RECCHECK^AMHLE2 I AMHOKAY W !,"Incomplete record!! Deleting record!!"  D DEL G EXIT

 D EXIT

 Q

GETPAT ;EP

 D ^XBFMK

 S AMHC=0

GETPAT1 ;

 S AMHPAT=""

 S DIC="^AUPNPAT(",DIC(0)="AEMQ" D ^DIC K DIC,DA,DR,DLAYGO,DIADD

 I Y<0 K AMHC Q

 S AMHPAT=+Y

 S X=AMHPAT D ^AMHPEDIT I '$D(X) S AMHC=AMHC+1 G GETPAT1

 W !?25,"Ok" S %=1 D YN^DICN I %'=1 S AMHPAT="" K AMHC Q

 K AMHC

 Q

EXIT ;

 D ^XBFMK

 D EN^XBVK("AMH")

 Q

DEL ;EP

 I $$IINTAKE^AMHLEDEL(AMHR) W !!,"This visit has an Initial Intake with Updates, it can not be deleted",!,"until the update documents have been deleted." D PAUSE Q

 S AMHVDLT=$P(^AMHREC(AMHR,0),U,16)

 S AMHRDEL=AMHR

 D EN^AMHLEDEL

 W !,"Record deleted." D PAUSE

 Q

PAUSE ;EP

 S DIR(0)="EO",DIR("A")="Press enter to continue...." D ^DIR K DIR S:$D(DUOUT) DIRUT=1

 Q

GETPROV ;get providers

 K DIR,DIC,DA,DTOUT,DIRUT,DUOUT,DIC,X,Y S DIR("B")=$P(^VA(200,DUZ,0),U),DIR(0)="9002011.02,.01O",DIR("A")="Enter PRIMARY PROVIDER" D ^DIR K DIR S:$D(DUOUT) DIRUT=1

 Q:$D(DIRUT)

 Q:Y=""

 S X=+Y,DIC("DR")=".02////"_$G(AMHPAT)_";.03////"_AMHR_";.04///PRIMARY",DIC="^AMHRPROV(",DIC(0)="MLQ",DIADD=1,DLAYGO=9002011.02 K DD,DO D FILE^DICN K DIC,DA,DO,DD,D0,DG,DH,DI,DIW,DIU,DIADD,DIE,DQ,DLAYGO

 I Y=-1 W !!,"Creating Primary Provider entry failed!!!",$C(7),$C(7) H 2

 Q

GETPOV ;

 D EN^XBNEW("EP^AMHLEA1","AMH*")

 Q

AMHLEA2   ; IHS/CMI/LAB - ADD NEW CHR ACTIVITY RECORDS ;

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

 +2       ;

 +3       ;add new records

 +4       ;get all items for a record, check record, file record

 +5       ;if not complete record, issue warning and delete record

BEGIN     ;add adm record

 +1        IF $DATA(IOF)

               WRITE @IOF

 +2        WRITE !!,"Update Case Tracking Visit Record",!

 +3        DO GETTYPE

 +4        IF AMHPTYPE=""

               DO EXIT

               QUIT 

 +5        DO GETDATE

 +6        IF AMHDATE=""

               DO EXIT

               QUIT 

 +7        DO CREATE

 +8        DO EXIT

 +9        QUIT 

GETTYPE   ;EP

 +1        SET AMHPTYPE=""

 +2        SET DIR(0)="S^M:MENTAL HEALTH DEFAULTS;S:SOCIAL SERVICES DEFAULTS;C:CHEMICAL DEPENDENCY or ALCOHOL/SUBSTANCE ABUSE;O:OTHER"

           SET DIR("A")="Which set of defaults do you want to use in Data Entry"

           KILL DA

           DO ^DIR

           KILL DIR

 +3        IF $DATA(DIRUT)

               QUIT 

 +4        SET AMHPTYPE=Y

 +5        QUIT 

GETDATE   ;EP - GET DATE OF ENCOUNTER

 +1        WRITE !!

 +2        SET AMHDATE=""

           SET DIR(0)="DO^:"_DT_":EPTX"

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

           DO ^DIR

           KILL DIR

           IF $DATA(DUOUT)

               SET DIRUT=1

 +3        IF $DATA(DIRUT)

               QUIT 

 +4        SET AMHDATE=Y

 +5        QUIT 

CREATE    ;EP

 +1        SET AMHACTN=1

 +2        SET APCDOVRR=""

 +3        DO GETPAT

 +4        IF '$GET(AMHPAT)

               WRITE !!,"No Patient Selected."

               DO EXIT

               QUIT 

 +5        KILL DD,D0,DO,DINUM,DIC,DA,DR

           SET DIC(0)="EL"

           SET DIC="^AMHREC("

           SET DLAYGO=9002011

           SET DIADD=1

           SET X=AMHDATE

           SET DIC("DR")=".03////"_DUZ_";.19////"_DT_";.21////"_DT_";.22////A;.08////"_$GET(AMHPAT)_";1111////1"

           DO FILE^DICN

           KILL DIC,DR,DIE,DIADD,DLAYGO,X,D0

 +6        IF Y=-1

               WRITE !!,$CHAR(7),$CHAR(7),"Behavioral Health Record is NOT complete!!  Deleting Record.",!

               DO PAUSE

               QUIT 

 +7        SET AMHR=+Y

           SET DIE="^AMHREC("

           SET DA=AMHR

           SET DR="5100///NOW"

           SET DR(2,9002011.5101)=".02////^S X=DUZ"

           DO ^DIE

           KILL DIE,DA,DR

 +8        DO GETPROV

 +9        SET DA=AMHR

           SET DDSFILE=9002011

           SET DR="[AMH ADD CASE TRACKING REC]"

           DO ^DDS

 +10       IF $DATA(DIMSG)

               WRITE !!,"ERROR IN SCREENMAN FORM!!  ***NOTIFY PROGRAMMER***"

               SET AMHQUIT=1

               KILL DIMSG

               QUIT 

 +11       IF '$DATA(^AMHRPRO("AD",AMHR))!('$DATA(^AMHRPROV("AD",AMHR)))

               WRITE !!,"Incomplete record!! Deleting record!!"

               DO DEL

               GOTO EXIT

 +12       SET AMHOKAY=0

           DO RECCHECK^AMHLE2

           IF AMHOKAY

               WRITE !,"Incomplete record!! Deleting record!!"

               DO DEL

               GOTO EXIT

 +13       DO EXIT

 +14       QUIT 

GETPAT    ;EP

 +1        DO ^XBFMK

 +2        SET AMHC=0

GETPAT1   ;

 +1        SET AMHPAT=""

 +2        SET DIC="^AUPNPAT("

           SET DIC(0)="AEMQ"

           DO ^DIC

           KILL DIC,DA,DR,DLAYGO,DIADD

 +3        IF Y<0

               KILL AMHC

               QUIT 

 +4        SET AMHPAT=+Y

 +5        SET X=AMHPAT

           DO ^AMHPEDIT

           IF '$DATA(X)

               SET AMHC=AMHC+1

               GOTO GETPAT1

 +6        WRITE !?25,"Ok"

           SET %=1

           DO YN^DICN

           IF %'=1

               SET AMHPAT=""

               KILL AMHC

               QUIT 

 +7        KILL AMHC

 +8        QUIT 

EXIT      ;

 +1        DO ^XBFMK

 +2        DO EN^XBVK("AMH")

 +3        QUIT 

DEL       ;EP

 +1        IF $$IINTAKE^AMHLEDEL(AMHR)

               WRITE !!,"This visit has an Initial Intake with Updates, it can not be deleted",!,"until the update documents have been deleted."

               DO PAUSE

               QUIT 

 +2        SET AMHVDLT=$PIECE(^AMHREC(AMHR,0),U,16)

 +3        SET AMHRDEL=AMHR

 +4        DO EN^AMHLEDEL

 +5        WRITE !,"Record deleted."

           DO PAUSE

 +6        QUIT 

PAUSE     ;EP

 +1        SET DIR(0)="EO"

           SET DIR("A")="Press enter to continue...."

           DO ^DIR

           KILL DIR

           IF $DATA(DUOUT)

               SET DIRUT=1

 +2        QUIT 

GETPROV   ;get providers

 +1        KILL DIR,DIC,DA,DTOUT,DIRUT,DUOUT,DIC,X,Y

           SET DIR("B")=$PIECE(^VA(200,DUZ,0),U)

           SET DIR(0)="9002011.02,.01O"

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

           DO ^DIR

           KILL DIR

           IF $DATA(DUOUT)

               SET DIRUT=1

 +2        IF $DATA(DIRUT)

               QUIT 

 +3        IF Y=""

               QUIT 

 +4        SET X=+Y

           SET DIC("DR")=".02////"_$GET(AMHPAT)_";.03////"_AMHR_";.04///PRIMARY"

           SET DIC="^AMHRPROV("

           SET DIC(0)="MLQ"

           SET DIADD=1

           SET DLAYGO=9002011.02

           KILL DD,DO

           DO FILE^DICN

           KILL DIC,DA,DO,DD,D0,DG,DH,DI,DIW,DIU,DIADD,DIE,DQ,DLAYGO

 +5        IF Y=-1

               WRITE !!,"Creating Primary Provider entry failed!!!",$CHAR(7),$CHAR(7)

               HANG 2

 +6        QUIT 

GETPOV    ;

 +1        DO EN^XBNEW("EP^AMHLEA1","AMH*")

 +2        QUIT