- 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
