- 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
