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

AQAOPAR.m

Go to the documentation of this file. 
  1. AQAOPAR ; IHS/ORDC/LJF - ADD ENTRY TO QI PARAMETER FILE ;
  1.  ;;1.01;QAI MANAGEMENT;;OCT 05, 1995
  1.  ;
  1.  ;This rtn contains 2 entry points; one for adding a new facility entry
  1.  ;to the QI Parameter file and the other for editing the RPMS linkages
  1.  ;for each facility.
  1.  ;
  1. SITE ; >>> ask user for facility name
  1.  W !! K DIC S DIC="^AUTTLOC(",DIC(0)="AEMZQ"
  1.  S DIC("A")="Select QI FACILITY NAME:  " D ^DIC
  1.  G EXIT:$D(DTOUT),EXIT:$D(DUOUT),EXIT:X="",SITE:Y=-1 S AQAOFAC=+Y
  1.  I $D(^AQAGP(AQAOFAC)) D  G SITE
  1.  .W !!,"This facility is ALREADY set up in the QI Parameter file!!"
  1.  ;
  1. SURE ; >>> ask user if he is sure he wants to add this facility
  1.  W !! K DIR,DIC S DIR(0)="YO",DIR("B")="NO"
  1.  S DIR("A")="Okay to ADD this facility to the QI PARAMETER file"
  1.  S DIR("?",1)="Answer YES to create an entry in the QI Parameter file"
  1.  S DIR("?",2)="for the facility you selected.  Answer NO to select "
  1.  S DIR("?")="another facility."
  1.  D ^DIR G EXIT:$D(DIRUT),SITE:Y=0
  1.  ;
  1. ADD ; >>> set variables and call file^dicn
  1.  W !! K DD,DO,DIC,DIR S DLAYGO=9002166,DIC="^AQAGP(",DIC(0)="L"
  1.  S (DINUM,X)=AQAOFAC,DIC("DR")="[AQAO PARAM ADD]"
  1.  L +(^AQAGP(0)):1 I '$T D  G EXIT
  1.  .W !!,"CANNOT ADD; ANOTHER USER ADDING TO THIS FILE. TRY AGAIN.",!
  1.  D FILE^DICN L -(^AQAGP(0))
  1.  W !!,"CREATING ENTRY . . ."
  1.  I Y=-1 W !!,"**ERROR**  COULD NOT CREATE ENTRY IN FILE!" G EXIT
  1.  W !!,"ENTRY CREATED!"
  1.  W !!,"To ACTIVATE any of the automatic linkages, please use the option"
  1.  W !,"titled EDIT PARAMETER LINKAGES and select the same facility."
  1.  W !! G SITE
  1.  ;
  1. EXIT ; >>> eoj
  1.  I $D(AQAOFAC) L -^AQAGP(AQAOFAC)
  1.  D KILL^AQAOUTIL K ^UTILITY("DIQ1",$J)
  1.  Q
  1.  ;
  1.  ;
  1. EDIT ;ENTRY POINT for editing of qi parameter file
  1.  ;called by option AQAO PKG PARAMETER LINK
  1.  ;
  1.  I $D(AQAOFAC) L -^AQAGP(AQAOFAC)
  1.  W !! K DIC S DIC="^AQAGP(",DIC(0)="AEMZQ"
  1.  S DIC("A")="Select QI PARAMETER FACILITY:  " D ^DIC
  1.  G EXIT:$D(DTOUT),EXIT:$D(DUOUT),EXIT:X="",MENU:Y=-1 S AQAOFAC=+Y
  1.  L +^AQAGP(AQAOFAC):1 I '$T D  G EDIT
  1.  .W !!,"CANNOT EDIT; ANOTHER USER IS EDITING THIS ENTRY. TRY AGAIN.",!
  1.  ;
  1.  K DIC,DIR S DIR(0)="LO^1:8^K:X#1 X"
  1.  S DIR("A")="Choose ONE or MORE to Edit"
  1.  S AQAOC=0 F I=1001:10:1071 D
  1.  .S X=$P(^AQAGP(AQAOFAC,"ADT"),U,+$E(I,3,4)),AQAOC=AQAOC+1 ;status/cnt
  1.  .S DIR("A",AQAOC)=AQAOC_") "_$P(^DD(9002166.4,I,0),U)
  1.  .S Y=50-$L(DIR("A",AQAOC)),Z="",$P(Z," ",Y)=""
  1.  .S DIR("A",AQAOC)="  "_DIR("A",AQAOC)_Z_$S(X=1:"[ON]",1:"[OFF]")
  1.  S DIR("A",AQAOC+1)=" "
  1.  D ^DIR G MENU:$D(DIRUT),MENU:Y=-1 S AQAORNG=Y
  1.  ;
  1. LOOP ; >>> loop thru links chosen and edit
  1.  S AQAOI=+AQAORNG,AQAOI=10_(AQAOI-1)_1 ;get next link
  1.  ;
  1.  ; >> print status of link
  1.  W !!!,"Current status of ",$P(^DD(9002166.4,AQAOI,0),U),":  "
  1.  K ^UTILITY("DIQ1",$J)
  1.  S DIC=9002166.4,DA=AQAOFAC,DR="" F I=0,1,3 S DR=DR_(AQAOI+I)_";"
  1.  D EN^DIQ1 W ^UTILITY("DIQ1",$J,9002166.4,AQAOFAC,AQAOI)
  1.  W !?11,"INDICATOR:  "
  1.  W $S(^UTILITY("DIQ1",$J,9002166.4,AQAOFAC,AQAOI+1)="":"<NONE DEFINED>",1:^(AQAOI+1))
  1.  W ?40,"OKAY TO DUPLICATE ON SAME DAY:  "
  1.  W ^UTILITY("DIQ1",$J,9002166.4,AQAOFAC,AQAOI+3)
  1.  ;
  1. IND ; >> indicator edit
  1.  W !! K DIR S DIR(0)="F^7:7",DIR("A")=$P(^DD(9002166.4,AQAOI+1,0),U)
  1.  S DIR("?")="Enter INDICATOR #; Must be 7 characters long."
  1.  S DIR("??")="^D INDQUES^AQAOPAR"
  1.  S DIR("B")=$P(^AQAGP(AQAOFAC,"ADT"),U,+$E(AQAOI+1,3,4))
  1.  K:DIR("B")="" DIR("B") D ^DIR
  1.  G MENU:$D(DTOUT),RESET:$D(DUOUT)
  1.  I '$D(^AQAO(2,"B",Y)) W !!,*7,"INDICATOR DOES NOT EXIST IN FILE!" G IND
  1.  S Z=$O(^AQAO(2,"B",Y,0))
  1.  I Z="" W !!,*7,"INDICATOR DOES NOT EXIST IN FILE!" G IND
  1.  I $P(^AQAO(2,Z,0),U,6)'="A" W !!,*7,"INDICATOR INACTIVE!" G IND
  1.  K DIE S DIE="^AQAGP(",DA=AQAOFAC,DR=(AQAOI+1)_"////"_Y D ^DIE
  1.  ;
  1. DUPOKAY ; >> ask user if dup entry okay for linkage
  1.  K DIE,DIC S DIE="^AQAGP(",DA=AQAOFAC,DR=(AQAOI+3)_";"_AQAOI
  1.  D ^DIE
  1.  ;
  1. SERVICES ; >> link services to this linkage
  1.  I $P(^AQAGP(AQAOFAC,"ADT"),U,$E(AQAOI,3,4))=1 D CURRENT^AQAOPAR1
  1.  ;
  1. RESET ; >> reset to remaining links selected
  1.  S AQAORNG=$P(AQAORNG,",",2,99)
  1.  G MENU1:+AQAORNG=0 ;end of loop
  1.  G LOOP ;otherwise continue looping thru range selected
  1.  ;
  1.  ;
  1. INDQUES ;ENTRY POINT called by xecute help on indicator fields
  1.  S DIC="^AQAO(2,",DIC(0)="EMZQ",D="B",DZ="??"
  1.  D DQ^DICQ
  1.  Q
  1.  ;
  1.  ;
  1. DUPQUES ;ENTRY POINT called by xecute help on dupl okay? fields 
  1.  W !!?5,"Answer YES to allow a duplicate event on the same day to "
  1.  W !?5,"create another occurrence;  Answer NO to allow only ONE event"
  1.  W !?5,"per day to be entered as an occurrence.",!!
  1.  Q
  1.  ;
  1.  ;
  1. LNKQUES ;ENTRY POINT called by xecute help on link fields
  1.  W !!?5,"Answer ON to turn on the link;"
  1.  W !?5,"Answer OFF to turn off the link.",!!
  1.  Q
  1.  ;
  1.  ;
  1. RICU ;ENTRY POINT called by xecute help on Return to ICU-# of days field
  1.  W !!,"Enter the number of days between stays in ICU that you want"
  1.  W !,"to track.  FOr example, to track all returns to ICU within 72"
  1.  W !,"hours, enter 3 for three days.",!!
  1.  Q