ACMPLAN.m

ACMPLAN ; IHS/TUCSON/TMJ - CARE PLAN ;

 ;;2.0;ACM CASE MANAGEMENT SYSTEM;;JAN 10, 1996

EN D HEAD^ACMMENU

 W !!?14,"Update ",@ACMRVON,"PLAN OF CARE",@ACMRVOFF,!?17,"for ",@ACMRVON,ACMPTNA2,@ACMRVOFF,!!?14,"CARE PLAN CATEGORY",?50,"CARE PLAN LAST EDITED",!?14,"----------------------",?50,"-----------------------"

PP D ACMTEMP

 W !?14,"MEDICAL CARE PLAN",?50,ACMMED,!?14,"NURSING PLAN",?50,ACMPHN,!?14,"SOCIAL SERVICES PLAN",?50,ACMSS,!?14,"EDUCATIONAL PLAN",?50,ACMEDP,!?14,"MENTAL HEALTH PLAN",?50,ACMMH,!?14,"OTHER PLANS",?50,ACMOTH

DIC S DIC="^ACM(48.1,",DIC(0)="AEQM",DIC("A")=" SELECT PLAN: "

 W !

 D ^DIC K DIC

 G:X="" EXIT

 I $E(X)=U S ACMQUIT="" S:X["^" ACMOUT="" G EXIT

 S X=+Y

 I $D(^ACM(48,"AC",ACMRG,ACMPTNO,+Y)) S DA=^(+Y) G DIE

 K DIC,DD

 S DIC="^ACM(48,",DIC(0)="L",DIC("DR")=".02////"_ACMPTNO_";.03////"_ACMRGDFN_";.04////"_ACMRG

 K DD,DO D FILE^DICN S DA=+Y K DIC,DR,DD

DIE S DIE="^ACM(48,",DR=".02////"_ACMPTNO_";.03////"_ACMRGDFN_";.04////"_ACMRG_";1;2///"_DT

 D ^DIE K DIC,DIE,DA,DR

 S DIE="^ACM(41,",DA=ACMRGDFN,DR="11///TODAY" D ^DIE K DIC,DIE,DA,DR

 I $D(ACMFLAG),ACMFLAG'="" G EXIT

 G EN

 Q

ACMTEMP ;

 S (ACMMED,ACMPHN,ACMSS,ACMEDP,ACMMH,ACMOTH)="*** NO PLAN ON FILE ***",(ACMAA,ACMP)=""

 F  S ACMAA=$O(^ACM(48,"AC",ACMRG,ACMPTNO,ACMAA)) Q:ACMAA=""  S ACMA=^(ACMAA) D FIND

 Q

FIND ;

 S ACMP=$P(^ACM(48,ACMA,0),U)

 I ACMP=1,$D(^ACM(48,ACMA,4)) S ACMMED=$P(^ACM(48,ACMA,4),U) I +ACMMED>0 S Y=ACMMED X ^DD("DD") S ACMMED=Y

 I ACMP=2,$D(^ACM(48,ACMA,4)) S ACMPHN=$P(^ACM(48,ACMA,4),U) I +ACMPHN>0 S Y=ACMPHN X ^DD("DD") S ACMPHN=Y

 I ACMP=3,$D(^ACM(48,ACMA,4)) S ACMSS=$P(^ACM(48,ACMA,4),U) I +ACMSS>0 S Y=ACMSS X ^DD("DD") S ACMSS=Y

 I ACMP=4,$D(^ACM(48,ACMA,4)) S ACMMH=$P(^ACM(48,ACMA,4),U) I +ACMMH>0 S Y=ACMMH X ^DD("DD") S ACMMH=Y

 I ACMP=5,$D(^ACM(48,ACMA,4)) S ACMOTH=$P(^ACM(48,ACMA,4),U) I +ACMOTH>0 S Y=ACMOTH X ^DD("DD") S ACMOTH=Y

 I ACMP=6,$D(^ACM(48,ACMA,1,0)) S ACMEDP=$P(^ACM(48,ACMA,4),U) I +ACMEDP>0 S Y=ACMEDP X ^DD("DD") S ACMEDP=Y

 Q

EXIT ;

 K ACMX,ACMA,ACMAA,ACMMED,ACMPHN,ACMSS,ACMEDP,ACMMH,ACMOTH,ACMP,ACMFLAG

 Q

ACMPLAN   ; IHS/TUCSON/TMJ - CARE PLAN ;

 +1       ;;2.0;ACM CASE MANAGEMENT SYSTEM;;JAN 10, 1996

EN         DO HEAD^ACMMENU

 +1        WRITE !!?14,"Update ",@ACMRVON,"PLAN OF CARE",@ACMRVOFF,!?17,"for ",@ACMRVON,ACMPTNA2,@ACMRVOFF,!!?14,"CARE PLAN CATEGORY",?50,"CARE PLAN LAST EDITED",!?14,"----------------------",?50,"-----------------------"

PP         DO ACMTEMP

 +1        WRITE !?14,"MEDICAL CARE PLAN",?50,ACMMED,!?14,"NURSING PLAN",?50,ACMPHN,!?14,"SOCIAL SERVICES PLAN",?50,ACMSS,!?14,"EDUCATIONAL PLAN",?50,ACMEDP,!?14,"MENTAL HEALTH PLAN",?50,ACMMH,!?14,"OTHER PLANS",?50,ACMOTH

DIC        SET DIC="^ACM(48.1,"

           SET DIC(0)="AEQM"

           SET DIC("A")=" SELECT PLAN: "

 +1        WRITE !

 +2        DO ^DIC

           KILL DIC

 +3        IF X=""

               GOTO EXIT

 +4        IF $EXTRACT(X)=U

               SET ACMQUIT=""

               IF X["^"

                   SET ACMOUT=""

               GOTO EXIT

 +5        SET X=+Y

 +6        IF $DATA(^ACM(48,"AC",ACMRG,ACMPTNO,+Y))

               SET DA=^(+Y)

               GOTO DIE

 +7        KILL DIC,DD

 +8        SET DIC="^ACM(48,"

           SET DIC(0)="L"

           SET DIC("DR")=".02////"_ACMPTNO_";.03////"_ACMRGDFN_";.04////"_ACMRG

 +9        KILL DD,DO

           DO FILE^DICN

           SET DA=+Y

           KILL DIC,DR,DD

DIE        SET DIE="^ACM(48,"

           SET DR=".02////"_ACMPTNO_";.03////"_ACMRGDFN_";.04////"_ACMRG_";1;2///"_DT

 +1        DO ^DIE

           KILL DIC,DIE,DA,DR

 +2        SET DIE="^ACM(41,"

           SET DA=ACMRGDFN

           SET DR="11///TODAY"

           DO ^DIE

           KILL DIC,DIE,DA,DR

 +3        IF $DATA(ACMFLAG)

               IF ACMFLAG'=""

                   GOTO EXIT

 +4        GOTO EN

 +5        QUIT 

ACMTEMP   ;

 +1        SET (ACMMED,ACMPHN,ACMSS,ACMEDP,ACMMH,ACMOTH)="*** NO PLAN ON FILE ***"

           SET (ACMAA,ACMP)=""

 +2        FOR 

               SET ACMAA=$ORDER(^ACM(48,"AC",ACMRG,ACMPTNO,ACMAA))

               IF ACMAA=""

                   QUIT 

               SET ACMA=^(ACMAA)

               DO FIND

 +3        QUIT 

FIND      ;

 +1        SET ACMP=$PIECE(^ACM(48,ACMA,0),U)

 +2        IF ACMP=1

               IF $DATA(^ACM(48,ACMA,4))

                   SET ACMMED=$PIECE(^ACM(48,ACMA,4),U)

                   IF +ACMMED>0

                       SET Y=ACMMED

                       XECUTE ^DD("DD")

                       SET ACMMED=Y

 +3        IF ACMP=2

               IF $DATA(^ACM(48,ACMA,4))

                   SET ACMPHN=$PIECE(^ACM(48,ACMA,4),U)

                   IF +ACMPHN>0

                       SET Y=ACMPHN

                       XECUTE ^DD("DD")

                       SET ACMPHN=Y

 +4        IF ACMP=3

               IF $DATA(^ACM(48,ACMA,4))

                   SET ACMSS=$PIECE(^ACM(48,ACMA,4),U)

                   IF +ACMSS>0

                       SET Y=ACMSS

                       XECUTE ^DD("DD")

                       SET ACMSS=Y

 +5        IF ACMP=4

               IF $DATA(^ACM(48,ACMA,4))

                   SET ACMMH=$PIECE(^ACM(48,ACMA,4),U)

                   IF +ACMMH>0

                       SET Y=ACMMH

                       XECUTE ^DD("DD")

                       SET ACMMH=Y

 +6        IF ACMP=5

               IF $DATA(^ACM(48,ACMA,4))

                   SET ACMOTH=$PIECE(^ACM(48,ACMA,4),U)

                   IF +ACMOTH>0

                       SET Y=ACMOTH

                       XECUTE ^DD("DD")

                       SET ACMOTH=Y

 +7        IF ACMP=6

               IF $DATA(^ACM(48,ACMA,1,0))

                   SET ACMEDP=$PIECE(^ACM(48,ACMA,4),U)

                   IF +ACMEDP>0

                       SET Y=ACMEDP

                       XECUTE ^DD("DD")

                       SET ACMEDP=Y

 +8        QUIT 

EXIT      ;

 +1        KILL ACMX,ACMA,ACMAA,ACMMED,ACMPHN,ACMSS,ACMEDP,ACMMH,ACMOTH,ACMP,ACMFLAG

 +2        QUIT