AQAODICC ; IHS/ORDC/LJF - DATA ENTRY OPTION FOR CRITERIA ;
;;1.01;QAI MANAGEMENT;;OCT 05, 1995
;
;This rtn contains the code for user interface when adding and
;editing review criteria to indicators.
;
D CRINTRO^AQAOHCRT ;display intro text
INDC ; >>> ask for indicator that will be linked to criteria
W !!!,"Enter the INDICATOR for which you are defining review criteria:"
S AQAOIND=+$$IND^AQAOLKP G END:AQAOIND=0,END:AQAOIND=-1
;
FIND ; >>> find all criteria already linked to this indicator
S (AQAOX,AQAOCNT)=0 K AQAOARR
F S AQAOX=$O(^AQAO1(6,"C",AQAOIND,AQAOX)) Q:AQAOX="" D
.S AQAOY=0
.F S AQAOY=$O(^AQAO1(6,"C",AQAOIND,AQAOX,AQAOY)) Q:AQAOY="" D
..Q:'$D(^AQAO1(6,AQAOX,"IND",AQAOY,0))
..S AQAOCNT=AQAOCNT+1,AQAOARR(AQAOCNT)=AQAOX_U_AQAOY
;
NONE ; >>> if none, ask to add
G DISPLAY:$D(AQAOARR) ;if any already linked
W !!,"NO CRITERIA ALREADY LINKED . . .",!
K DIR S DIR(0)="YO",DIR("A")="Do you wish to ADD NEW CRITERIA"
D ^DIR G INDC:$D(DIRUT),INDC:Y=0
D ADD G FIND
;
DISPLAY ; >> display all criteria
W !!?5,"<<< REVIEW CRITERIA >>>",!
S AQAOX=0
F S AQAOX=$O(AQAOARR(AQAOX)) Q:AQAOX="" D
.W !,AQAOX,") ",$P(^AQAO1(6,$P(AQAOARR(AQAOX),U),0),U) ;criteria phrase
.S Y=$P(^AQAO1(6,$P(AQAOARR(AQAOX),U),0),U,2)
.S C=$P(^DD(9002169.6,.02,0),U,2) D Y^DIQ W ?65,Y ;type of criteria
W !,(AQAOCNT+1),") ADD NEW ENTRY"
K DIR S DIR(0)="NO^1:"_(AQAOCNT+1)
S DIR("A")="Choose ONE from the list OR hit <return> to continue"
S DIR("?",1)="Choose a Review Criterion from the list above,"
S (DIR("?",2),DIR("?",4))=" OR"
S DIR("?",3)="Choose the option ADD NEW ENTRY.",DIR("?")=" "
S DIR("?",5)="Press the RETURN key to choose another Indicator?"
D ^DIR G INDC:$D(DIRUT),DISPLAY:Y=-1
;
I Y=(AQAOCNT+1) D ADD G FIND
E S AQAOY=Y D EDIT G FIND
;
;
END ; >>> eoj
D KILL^AQAOUTIL Q
;
;
ADD ; >> SUBRTN to add new entry
L +^AQAO1(6,0):1 I '$T D Q
.W !!,"CANNOT ACCESS FILE; ANOTHER USER ADDING ENTRY. TRY AGAIN.",!
K DIC S (DIC,DLAYGO)=9002169.6,DIC(0)="AEMQL"
D ^DIC L -^AQAO1(6,0) Q:$D(DIRUT) Q:Y=-1 S AQAODA=+Y
L +^AQAO1(6,AQAODA):1 I '$T D Q
.W !!,"CANNOT EDIT; ANOTHER USER EDITING THIS ENTRY. TRY AGAIN.",!
I '$D(^AQAO1(6,AQAODA,"IND",0)) S ^(0)="^9002169.699P"
I '$D(^AQAO1(6,AQAODA,"IND","B",AQAOIND)) D
.K DIC S DIC="^AQAO1(6,"_AQAODA_",""IND"",",DIC(0)="L"
.S DA(1)=AQAODA,X=$P(^AQAO(2,AQAOIND,0),U),DIC("DR")=".02"
.D ^DIC
K DIC S DIE=9002169.6,DR="[AQAO CRITERIA EDIT-E1]",DA=AQAODA
D ^DIE
L -^AQAO1(6,AQAODA) Q
;
;
EDIT ; >> SUBRTN to edit or delete entry
W !!,"To DELETE the link between this criteria and your indicator"
W !,"enter an '@' at the INDICATOR prompt; otherwise hit <return>."
W ! S AQAODA1=$P(AQAOARR(AQAOY),U),AQAODA=$P(AQAOARR(AQAOY),U,2)
S AQAODR=".01;.02",AQAODIC="^AQAO1(6,"_AQAODA1_",""IND"","
D DIE^AQAODIC ;call dic/die driver
Q:'$D(^AQAO1(6,"C",AQAOIND,AQAODA1)) ;link deleted
;
EDIT1 S AQAODIC="^AQAO1(6,",AQAODR="[AQAO CRITERIA EDIT-E1]"
S AQAODA=$P(AQAOARR(AQAOY),U) D DIE^AQAODIC
Q
AQAODICC ; IHS/ORDC/LJF - DATA ENTRY OPTION FOR CRITERIA ;
+1 ;;1.01;QAI MANAGEMENT;;OCT 05, 1995
+2 ;
+3 ;This rtn contains the code for user interface when adding and
+4 ;editing review criteria to indicators.
+5 ;
+6 ;display intro text
DO CRINTRO^AQAOHCRT
INDC ; >>> ask for indicator that will be linked to criteria
+1 WRITE !!!,"Enter the INDICATOR for which you are defining review criteria:"
+2 SET AQAOIND=+$$IND^AQAOLKP
IF AQAOIND=0
GOTO END
IF AQAOIND=-1
GOTO END
+3 ;
FIND ; >>> find all criteria already linked to this indicator
+1 SET (AQAOX,AQAOCNT)=0
KILL AQAOARR
+2 FOR
SET AQAOX=$ORDER(^AQAO1(6,"C",AQAOIND,AQAOX))
IF AQAOX=""
QUIT
Begin DoDot:1
+3 SET AQAOY=0
+4 FOR
SET AQAOY=$ORDER(^AQAO1(6,"C",AQAOIND,AQAOX,AQAOY))
IF AQAOY=""
QUIT
Begin DoDot:2
+5 IF '$DATA(^AQAO1(6,AQAOX,"IND",AQAOY,0))
QUIT
+6 SET AQAOCNT=AQAOCNT+1
SET AQAOARR(AQAOCNT)=AQAOX_U_AQAOY
End DoDot:2
End DoDot:1
+7 ;
NONE ; >>> if none, ask to add
+1 ;if any already linked
IF $DATA(AQAOARR)
GOTO DISPLAY
+2 WRITE !!,"NO CRITERIA ALREADY LINKED . . .",!
+3 KILL DIR
SET DIR(0)="YO"
SET DIR("A")="Do you wish to ADD NEW CRITERIA"
+4 DO ^DIR
IF $DATA(DIRUT)
GOTO INDC
IF Y=0
GOTO INDC
+5 DO ADD
GOTO FIND
+6 ;
DISPLAY ; >> display all criteria
+1 WRITE !!?5,"<<< REVIEW CRITERIA >>>",!
+2 SET AQAOX=0
+3 FOR
SET AQAOX=$ORDER(AQAOARR(AQAOX))
IF AQAOX=""
QUIT
Begin DoDot:1
+4 ;criteria phrase
WRITE !,AQAOX,") ",$PIECE(^AQAO1(6,$PIECE(AQAOARR(AQAOX),U),0),U)
+5 SET Y=$PIECE(^AQAO1(6,$PIECE(AQAOARR(AQAOX),U),0),U,2)
+6 ;type of criteria
SET C=$PIECE(^DD(9002169.6,.02,0),U,2)
DO Y^DIQ
WRITE ?65,Y
End DoDot:1
+7 WRITE !,(AQAOCNT+1),") ADD NEW ENTRY"
+8 KILL DIR
SET DIR(0)="NO^1:"_(AQAOCNT+1)
+9 SET DIR("A")="Choose ONE from the list OR hit <return> to continue"
+10 SET DIR("?",1)="Choose a Review Criterion from the list above,"
+11 SET (DIR("?",2),DIR("?",4))=" OR"
+12 SET DIR("?",3)="Choose the option ADD NEW ENTRY."
SET DIR("?")=" "
+13 SET DIR("?",5)="Press the RETURN key to choose another Indicator?"
+14 DO ^DIR
IF $DATA(DIRUT)
GOTO INDC
IF Y=-1
GOTO DISPLAY
+15 ;
+16 IF Y=(AQAOCNT+1)
DO ADD
GOTO FIND
+17 IF '$TEST
SET AQAOY=Y
DO EDIT
GOTO FIND
+18 ;
+19 ;
END ; >>> eoj
+1 DO KILL^AQAOUTIL
QUIT
+2 ;
+3 ;
ADD ; >> SUBRTN to add new entry
+1 LOCK +^AQAO1(6,0):1
IF '$TEST
Begin DoDot:1
+2 WRITE !!,"CANNOT ACCESS FILE; ANOTHER USER ADDING ENTRY. TRY AGAIN.",!
End DoDot:1
QUIT
+3 KILL DIC
SET (DIC,DLAYGO)=9002169.6
SET DIC(0)="AEMQL"
+4 DO ^DIC
LOCK -^AQAO1(6,0)
IF $DATA(DIRUT)
QUIT
IF Y=-1
QUIT
SET AQAODA=+Y
+5 LOCK +^AQAO1(6,AQAODA):1
IF '$TEST
Begin DoDot:1
+6 WRITE !!,"CANNOT EDIT; ANOTHER USER EDITING THIS ENTRY. TRY AGAIN.",!
End DoDot:1
QUIT
+7 IF '$DATA(^AQAO1(6,AQAODA,"IND",0))
SET ^(0)="^9002169.699P"
+8 IF '$DATA(^AQAO1(6,AQAODA,"IND","B",AQAOIND))
Begin DoDot:1
+9 KILL DIC
SET DIC="^AQAO1(6,"_AQAODA_",""IND"","
SET DIC(0)="L"
+10 SET DA(1)=AQAODA
SET X=$PIECE(^AQAO(2,AQAOIND,0),U)
SET DIC("DR")=".02"
+11 DO ^DIC
End DoDot:1
+12 KILL DIC
SET DIE=9002169.6
SET DR="[AQAO CRITERIA EDIT-E1]"
SET DA=AQAODA
+13 DO ^DIE
+14 LOCK -^AQAO1(6,AQAODA)
QUIT
+15 ;
+16 ;
EDIT ; >> SUBRTN to edit or delete entry
+1 WRITE !!,"To DELETE the link between this criteria and your indicator"
+2 WRITE !,"enter an '@' at the INDICATOR prompt; otherwise hit <return>."
+3 WRITE !
SET AQAODA1=$PIECE(AQAOARR(AQAOY),U)
SET AQAODA=$PIECE(AQAOARR(AQAOY),U,2)
+4 SET AQAODR=".01;.02"
SET AQAODIC="^AQAO1(6,"_AQAODA1_",""IND"","
+5 ;call dic/die driver
DO DIE^AQAODIC
+6 ;link deleted
IF '$DATA(^AQAO1(6,"C",AQAOIND,AQAODA1))
QUIT
+7 ;
EDIT1 SET AQAODIC="^AQAO1(6,"
SET AQAODR="[AQAO CRITERIA EDIT-E1]"
+1 SET AQAODA=$PIECE(AQAOARR(AQAOY),U)
DO DIE^AQAODIC
+2 QUIT
