Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: AQAODICC

AQAODICC.m

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