ACMDXIT ; IHS/TUCSON/TMJ - DEFINE STANDARD INTERVENTIONS ;
;;2.0;ACM CASE MANAGEMENT SYSTEM;;JAN 10, 1996
;;X.X;
EN F D EN1 Q:$D(ACMQUIT)
EXIT K ACM,ACMI,ACMX,ACMQUIT,ACMDXDA,ACMITDA,ACMMAX
Q
EN1 ;EP;TO SELECT DIAGNOSIS
K ACM
W @IOF
W !?20,"SELECT STANDARD INTERVENTIONS FOR DIAGNOSIS",!!
S DIC="^ACM(44.1,",DIC(0)="AEMQ",DIC("A")="Diagnosis...........: "
D ^DIC
I +Y<1 S ACMQUIT="" Q
S ACMDXDA=+Y
EN11 I '$D(^ACM(44.3,"AC",ACMDXDA)) D EN41 Q:'$D(^ACM(44.3,"AC",ACMDXDA))
F D EN2 Q:$D(ACMQUIT)
K ACMQUIT
Q
EN2 ;EP;ENTRY POINT
W @IOF,!?10,"STANDARD INTERVENTIONS FOR ",$P(^ACM(44.1,ACMDXDA,0),U),!
K ACM
S (ACM,ACMI)=0
F S ACM=$O(^ACM(44.3,"AC",ACMDXDA,ACM)) Q:'ACM I $D(^ACM(43.1,ACM,0)),$P(^(0),U)'="" S ACM($P(^(0),U))=$O(^ACM(44.3,"AC",ACMDXDA,ACM,0))_U_ACM,ACMI=ACMI+1
S ACMMAX=ACMI,ACMI=ACMI\2+(ACMI#2)
S ACMX=""
F ACM=1:1 S ACMX=$O(ACM(ACMX)) Q:ACMX="" D
.S ACM(ACM)=ACMX_U_ACM(ACMX)
.I $D(ACMPTNO),$D(ACMRG),$D(^ACM(43,"AC",ACMRG,ACMPTNO,$P(ACM(ACMX),U,2))) S ACM(ACM)="**"_ACM(ACM)
.K ACM(ACMX)
W !?5,"NO.",?10,"INTERVENTION",?45,"NO.",?50,"INTERVENTION",!?5,"---",?10,"-------------------------",?45,"---",?50,"-------------------------"
F ACM=1:1:ACMI W ! W:$D(ACM(ACM)) ?5,ACM,?10,$P(ACM(ACM),U) W:$D(ACM(ACM+ACMI)) ?45,ACM+ACMI,?50,$P(ACM(ACM+ACMI),U)
I $D(ACMPTNO) W !!?10,"'**' Indicates intervention already assigned to this patient."
EN3 S DIR(0)="SO^1:Add;2:Delete",DIR("A")="Which one"
D DIR
I Y=1 D EN4:'$D(ACMPTNO),EN6:$D(ACMPTNO) Q
I Y=2 D EN5
Q
EN4 F D EN41 Q:$D(ACMQUIT)
K ACMQUIT
Q
EN41 S DIC="^ACM(43.1,",DIC(0)="AELMQ",DIC("A")="INTERVENTION..: "
W !
D DIC
Q:$D(ACMQUIT)
S ACMITDA=+Y
I '$D(^ACM(44.3,"AC",ACMDXDA,ACMITDA)) S X=ACMDXDA,DIC="^ACM(44.3,",DIC(0)="L",DIC("DR")=".02////"_ACMITDA D FILE
Q
EN5 W !
S DIR(0)="LO^1:"_ACMMAX,DIR("A")="Which one(s)"
D DIR
Q:Y=""
S ACMY=Y
F ACMI=1:1 S ACM=$P(ACMY,",",ACMI) Q:ACM="" D
.I '$D(ACMPTNO),$D(ACM(ACM)),$P(ACM(ACM),U,2) S DIK="^ACM(44.3,",DA=$P(ACM(ACM),U,2) D ^DIK
.I $D(ACMPTNO),$D(ACM(ACM)),$P(ACM(ACM),U,2) S DIK="^ACM(43,",DA=$P(ACM(ACM),U,3) I $D(^ACM(43,"AC",ACMRG,ACMPTNO,DA)) S DA=^(DA) D ^DIK
Q
EN6 W !
N ACMDIC,ACMY,ACMDR
S DIR(0)="LO^1:"_ACMMAX,DIR("A")="Add which one(s)"
D DIR
Q:Y=""
S ACMX=Y
F ACMI=1:1 S ACM=$P(ACMX,",",ACMI) Q:ACM="" I $D(ACMPTNO),$D(ACM(ACM)),$P(ACM(ACM),U,2) S ACMDIC=43,ACMY=$P(ACM(ACM),U,3) D
.I '$D(^ACM(43,"AC",ACMRG,ACMPTNO,ACMY)) D DICN^ACMEP
.I $D(^ACM(43,"AC",ACMRG,ACMPTNO,ACMY)) S DA=^(ACMY),ACMDR="2T;3T;1T;4T" W !!,"INTERVENTION: ",$P(ACM(ACM),U) D DIE^ACMEP
Q
DIC D ^DIC S:+Y<1 ACMQUIT="" K DIC,DA,DD,DR,DINUM,D Q
DIK D ^DIK K DIK Q
DIR D ^DIR S:$D(DIRUT) ACMQUIT="" K DIR,DIRUT,DUOUT,DTOUT Q
FILE K DD,DO D FILE^DICN K DIC,DA,DD,DR,DINUM Q
ACMDXIT ; IHS/TUCSON/TMJ - DEFINE STANDARD INTERVENTIONS ;
+1 ;;2.0;ACM CASE MANAGEMENT SYSTEM;;JAN 10, 1996
+2 ;;X.X;
EN FOR
DO EN1
IF $DATA(ACMQUIT)
QUIT
EXIT KILL ACM,ACMI,ACMX,ACMQUIT,ACMDXDA,ACMITDA,ACMMAX
+1 QUIT
EN1 ;EP;TO SELECT DIAGNOSIS
+1 KILL ACM
+2 WRITE @IOF
+3 WRITE !?20,"SELECT STANDARD INTERVENTIONS FOR DIAGNOSIS",!!
+4 SET DIC="^ACM(44.1,"
SET DIC(0)="AEMQ"
SET DIC("A")="Diagnosis...........: "
+5 DO ^DIC
+6 IF +Y<1
SET ACMQUIT=""
QUIT
+7 SET ACMDXDA=+Y
EN11 IF '$DATA(^ACM(44.3,"AC",ACMDXDA))
DO EN41
IF '$DATA(^ACM(44.3,"AC",ACMDXDA))
QUIT
+1 FOR
DO EN2
IF $DATA(ACMQUIT)
QUIT
+2 KILL ACMQUIT
+3 QUIT
EN2 ;EP;ENTRY POINT
+1 WRITE @IOF,!?10,"STANDARD INTERVENTIONS FOR ",$PIECE(^ACM(44.1,ACMDXDA,0),U),!
+2 KILL ACM
+3 SET (ACM,ACMI)=0
+4 FOR
SET ACM=$ORDER(^ACM(44.3,"AC",ACMDXDA,ACM))
IF 'ACM
QUIT
IF $DATA(^ACM(43.1,ACM,0))
IF $PIECE(^(0),U)'=""
SET ACM($PIECE(^(0),U))=$ORDER(^ACM(44.3,"AC",ACMDXDA,ACM,0))_U_ACM
SET ACMI=ACMI+1
+5 SET ACMMAX=ACMI
SET ACMI=ACMI\2+(ACMI#2)
+6 SET ACMX=""
+7 FOR ACM=1:1
SET ACMX=$ORDER(ACM(ACMX))
IF ACMX=""
QUIT
Begin DoDot:1
+8 SET ACM(ACM)=ACMX_U_ACM(ACMX)
+9 IF $DATA(ACMPTNO)
IF $DATA(ACMRG)
IF $DATA(^ACM(43,"AC",ACMRG,ACMPTNO,$PIECE(ACM(ACMX),U,2)))
SET ACM(ACM)="**"_ACM(ACM)
+10 KILL ACM(ACMX)
End DoDot:1
+11 WRITE !?5,"NO.",?10,"INTERVENTION",?45,"NO.",?50,"INTERVENTION",!?5,"---",?10,"-------------------------",?45,"---",?50,"-------------------------"
+12 FOR ACM=1:1:ACMI
WRITE !
IF $DATA(ACM(ACM))
WRITE ?5,ACM,?10,$PIECE(ACM(ACM),U)
IF $DATA(ACM(ACM+ACMI))
WRITE ?45,ACM+ACMI,?50,$PIECE(ACM(ACM+ACMI),U)
+13 IF $DATA(ACMPTNO)
WRITE !!?10,"'**' Indicates intervention already assigned to this patient."
EN3 SET DIR(0)="SO^1:Add;2:Delete"
SET DIR("A")="Which one"
+1 DO DIR
+2 IF Y=1
IF '$DATA(ACMPTNO)
DO EN4
IF $DATA(ACMPTNO)
DO EN6
QUIT
+3 IF Y=2
DO EN5
+4 QUIT
EN4 FOR
DO EN41
IF $DATA(ACMQUIT)
QUIT
+1 KILL ACMQUIT
+2 QUIT
EN41 SET DIC="^ACM(43.1,"
SET DIC(0)="AELMQ"
SET DIC("A")="INTERVENTION..: "
+1 WRITE !
+2 DO DIC
+3 IF $DATA(ACMQUIT)
QUIT
+4 SET ACMITDA=+Y
+5 IF '$DATA(^ACM(44.3,"AC",ACMDXDA,ACMITDA))
SET X=ACMDXDA
SET DIC="^ACM(44.3,"
SET DIC(0)="L"
SET DIC("DR")=".02////"_ACMITDA
DO FILE
+6 QUIT
EN5 WRITE !
+1 SET DIR(0)="LO^1:"_ACMMAX
SET DIR("A")="Which one(s)"
+2 DO DIR
+3 IF Y=""
QUIT
+4 SET ACMY=Y
+5 FOR ACMI=1:1
SET ACM=$PIECE(ACMY,",",ACMI)
IF ACM=""
QUIT
Begin DoDot:1
+6 IF '$DATA(ACMPTNO)
IF $DATA(ACM(ACM))
IF $PIECE(ACM(ACM),U,2)
SET DIK="^ACM(44.3,"
SET DA=$PIECE(ACM(ACM),U,2)
DO ^DIK
+7 IF $DATA(ACMPTNO)
IF $DATA(ACM(ACM))
IF $PIECE(ACM(ACM),U,2)
SET DIK="^ACM(43,"
SET DA=$PIECE(ACM(ACM),U,3)
IF $DATA(^ACM(43,"AC",ACMRG,ACMPTNO,DA))
SET DA=^(DA)
DO ^DIK
End DoDot:1
+8 QUIT
EN6 WRITE !
+1 NEW ACMDIC,ACMY,ACMDR
+2 SET DIR(0)="LO^1:"_ACMMAX
SET DIR("A")="Add which one(s)"
+3 DO DIR
+4 IF Y=""
QUIT
+5 SET ACMX=Y
+6 FOR ACMI=1:1
SET ACM=$PIECE(ACMX,",",ACMI)
IF ACM=""
QUIT
IF $DATA(ACMPTNO)
IF $DATA(ACM(ACM))
IF $PIECE(ACM(ACM),U,2)
SET ACMDIC=43
SET ACMY=$PIECE(ACM(ACM),U,3)
Begin DoDot:1
+7 IF '$DATA(^ACM(43,"AC",ACMRG,ACMPTNO,ACMY))
DO DICN^ACMEP
+8 IF $DATA(^ACM(43,"AC",ACMRG,ACMPTNO,ACMY))
SET DA=^(ACMY)
SET ACMDR="2T;3T;1T;4T"
WRITE !!,"INTERVENTION: ",$PIECE(ACM(ACM),U)
DO DIE^ACMEP
End DoDot:1
+9 QUIT
DIC DO ^DIC
IF +Y<1
SET ACMQUIT=""
KILL DIC,DA,DD,DR,DINUM,D
QUIT
DIK DO ^DIK
KILL DIK
QUIT
DIR DO ^DIR
IF $DATA(DIRUT)
SET ACMQUIT=""
KILL DIR,DIRUT,DUOUT,DTOUT
QUIT
FILE KILL DD,DO
DO FILE^DICN
KILL DIC,DA,DD,DR,DINUM
QUIT
