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

AQAOPOS1.m

Go to the documentation of this file. 
  1. AQAOPOS1 ; IHS/ORDC/LJF - POST INIT ;
  1.  ;;1.01;QAI MANAGEMENT;;OCT 05, 1995
  1.  ;
  1.  ;This is a continuation of postinits.  Installs
  1.  ;indicators sent with the package, then calls ^AQAOPOS2.
  1.  ;
  1. 2 ; step 2 - install indicators sent with pkg
  1.  W !!,"STEP 2 - INSTALL INDICATORS DISTRIBUTED WITH PACKAGE",!!
  1.  W !,"I will install any indicator you do not already have PLUS"
  1.  W !,"those you do have but which are inactive.",!!
  1.  ;
  1.  ;want to update inactive ind?
  1.  I $O(^AQAO(2,0)) S AQAOUPD=$$INACT I AQAOUPD=U!(AQAOUPD="")!(AQAOUPD="N") G NEXT
  1.  ;
  1.  ; loop thru indicators in scratch file
  1.  S AQAOX=0 L +^AQAO(2,0):1
  1.  I '$T W !!,"INDICATOR FILE LOCKED!  BYPASSING STEP 2!",!! G NEXT
  1.  F  S AQAOX=$O(^AQAOXX(2,AQAOX)) Q:AQAOX'=+AQAOX  D
  1.  .S AQAOID=$P(^AQAOXX(2,AQAOX,0),U)
  1.  .;  if ind exists & inactive, ok to update?
  1.  .I $D(^AQAO(2,"B",AQAOID)) D  Q:$G(AQAONUPD)=U
  1.  ..S DA=$O(^AQAO(2,"B",AQAOID,0)) Q:DA=""  ;bad xref
  1.  ..I $P($G(^AQAO(2,DA,0)),U,6)'="I" S AQAONUPD=U Q  ;do not update active ind
  1.  ..I AQAOUPD="S" S AQAONUPD=$$UPD Q:AQAONUPD=U  ;not ok to update
  1.  ..S DIE="^AQAO(2,",DR=$$DRSET D ^DIE S Y=DA ;update ind
  1.  .;
  1.  .E  D  ; else create entry
  1.  ..K DIC,DD,DO S DIC="^AQAO(2,",DIC(0)="L",DLAYGO=9002164
  1.  ..S X=AQAOID,DIC("DR")=$$DRSET ;set dr string from gbl
  1.  ..D FILE^DICN Q:Y=-1
  1.  .;
  1.  .S AQAOIFN=+Y,AQAOCNT=0 ;set descrip wp field
  1.  .F  S AQAOCNT=$O(^AQAOXX(2,AQAOX,"D",AQAOCNT)) Q:AQAOCNT=""  D
  1.  ..S ^AQAO(2,AQAOIFN,"D",AQAOCNT,0)=^AQAOXX(2,AQAOX,"D",AQAOCNT,0)
  1.  .S ^AQAO(2,AQAOIFN,"D",0)=U_U_AQAOCNT_U_AQAOCNT_U_DT
  1.  .;
  1.  .S AQAOCNT=0 ;set methodology wp field
  1.  .F  S AQAOCNT=$O(^AQAOXX(2,AQAOX,"M",AQAOCNT)) Q:AQAOCNT=""  D
  1.  ..S ^AQAO(2,AQAOIFN,"M",AQAOCNT,0)=^AQAOXX(2,AQAOX,"M",AQAOCNT,0)
  1.  .S ^AQAO(2,AQAOIFN,"M",0)=U_U_AQAOCNT_U_AQAOCNT_U_DT
  1.  .;
  1.  .;install review criteria for ind
  1.  .Q:'$D(^AQAOXX(6,"C",AQAOX))  ;no crit for ind
  1.  .D CRIT ;install crit & ind links
  1.  ;
  1.  L -^AQAO(2,0)
  1. NEXT ; go to next rtn for more
  1.  D ^AQAOPOS2 Q
  1.  ;
  1.  ;
  1. CRIT ; SUBRTN to install criteria for ind
  1.  L +^AQAO1(6,0):1 I '$T W !!,"QI REVIEW CRITERIA file locked!" Q
  1.  L +^AQAO1(4,0):1 I '$T W !!,"QI CRITERIA CODES file locked" Q
  1.  ;
  1.  S AQAOC=0 ;get all crit for ind,add to site's file
  1.  F  S AQAOC=$O(^AQAOXX(6,"C",AQAOX,AQAOC)) Q:AQAOC=""  D
  1.  .Q:'$D(^AQAOXX(6,AQAOC,0))  S AQAOS=^(0)
  1.  .;
  1.  .; if crit doesn't exist, add it
  1.  .I '$D(^AQAO1(6,"B",$E($P(AQAOS,U),1,30))) D
  1.  ..K DD,DO,DIC S DIC="^AQAO1(6,",DIC(0)="L",X=$P(AQAOS,U)
  1.  ..S DIC("DR")=".02////"_$P(AQAOS,U,2)_";.03////"_$P(AQAOS,U,3)_";.04////"_$P(AQAOS,U,4)
  1.  ..S DLAYGO=9002169 D FILE^DICN K DLAYGO
  1.  ..I Y=-1 W !!,"Can't ADD ",$P(^AQAOXX(6,AQAOC,0),U)," as criterion." Q
  1.  ..S AQAOCIFN=+Y
  1.  ..;
  1.  ..S AQAOCD=0 ;add any crit codes, if any
  1.  ..F  S AQAOCD=$O(^AQAOXX(6,AQAOC,"CD",AQAOCD)) Q:AQAOCD'=+AQAOCD  D
  1.  ...Q:'$D(^AQAOXX(6,AQAOC,"CD",AQAOCD,0))  S AQAOCOD=^(0)
  1.  ...S AQAOSS=$G(^AQAOXX(4,AQAOCOD,0))
  1.  ...S AQAOCODN=$$CODE Q:AQAOCODN=U  ;get code,create if needed
  1.  ...I '$D(^AQAO1(6,AQAOCIFN,"CD",0)) S ^(0)="^9002169.61P^^"
  1.  ...S DIC="^AQAO1(6,"_AQAOCIFN_",""CD"",",DA(1)=AQAOCIFN
  1.  ...S DIC(0)="L",X=AQAOCODN D ^DIC
  1.  .;
  1.  .; link indicator to crit entry
  1.  .S AQAOCIFN=$O(^AQAO1(6,"B",$E($P(AQAOS,U),1,30),0)) Q:AQAOCIFN=""
  1.  .Q:$D(^AQAO1(6,"C",AQAOIFN,AQAOCIFN))  ;already linked
  1.  .I '$D(^AQAO1(6,AQAOCIFN,"IND",0)) S ^(0)="^9002169.699P^^"
  1.  .S DIC="^AQAO1(6,"_AQAOCIFN_",""IND"",",DA(1)=AQAOCIFN
  1.  .S DIC(0)="L",X=$P(^AQAO(2,AQAOIFN,0),U) D FILE^DICN
  1.  L -^AQAO1(6,0) L -^AQAO1(4,0)
  1.  Q
  1.  ;
  1.  ;
  1. CODE() ; EXTR VAR to add crit codes to file
  1.  N X,DD,DO,DIC,Y,DLAYGO
  1.  S X=$O(^AQAO1(4,"B",$E($P(AQAOSS,U),1,30),0)) I X="" S Y=""
  1.  I X]"",($P(AQAOSS,U,2)'=$P(^AQAO1(4,X,0),U,2)) S Y=""
  1.  I $D(Y) D
  1.  .S DIC="^AQAO1(4,",DIC(0)="L",DLAYGO=9002169
  1.  .S X=$P(AQAOSS,U),DIC("DR")=".02////"_$P(AQAOSS,U,2)
  1.  .K DD,DO D FILE^DICN S:Y=-1 X=U
  1.  Q X
  1.  ;
  1.  ;
  1. INACT() ;EXTR VAR to ask if updating ind is allowed 
  1.  N Y,DIR
  1.  S DIR(0)="SB^N:NONE;S:SELECTED;A:ALL"
  1.  S DIR("A",1)="You already have indicators in your file.  If I find"
  1.  S DIR("A",2)="any that match those I sent with this package, I will"
  1.  S DIR("A",3)="UPDATE them if they have been inactivated.  You can"
  1.  S DIR("A",4)="choose from:    NONE - do not update any"
  1.  S DIR("A",5)="                SELECTED - I will ask about each one"
  1.  S DIR("A",6)="                ALL - update all without further discussion"
  1.  S DIR("A")="UPDATE INACTIVE INDICATORS?" D ^DIR
  1.  Q Y
  1.  ;
  1.  ;
  1. UPD() ;EXTR VAR to ask if user wants indicator updated
  1.  N X,Y,DIR
  1.  S DIR(0)="Y",DIR("B")="YES"
  1.  S DIR("A",1)="You already have "_AQAOID_" as an inactive indicator."
  1.  S DIR("A")="Do you want to update this indicator" D ^DIR
  1.  S X=$S(Y=1:1,1:U)
  1.  Q X
  1.  ;
  1.  ;
  1. DRSET() ;EXTR VAR to set dr string
  1.  N X,Y S DR=""
  1.  S X=^AQAOXX(2,AQAOX,0) ;zero node data
  1.  F J=1:1 S Y=$P($T(DATA2+J),";;",2) Q:Y=""  D
  1.  .S Z=$P($T(DATA2+J),";;",3)
  1.  .S DR=DR_";"_Y_"////"_$P(X,U,Z)
  1.  S X=^AQAOXX(2,AQAOX,1) ;one node data
  1.  F J=1:1 S Y=$P($T(DATA2A+J),";;",2) Q:Y=""  D
  1.  .S Z=$P($T(DATA2A+J),";;",3)
  1.  .S DR=DR_";"_Y_"////"_$P(X,U,Z)
  1.  S DR=$E(DR,2,250)_";.06////I"
  1.  Q DR
  1.  ;
  1.  ;
  1. DATA2 ;; data for step 2 drset extr var
  1.  ;;.02;;2
  1.  ;;.03;;3
  1.  ;;.04;;4
  1.  ;;.05;;5
  1.  ;
  1. DATA2A ;; data for step 2 drset extr var second loop
  1.  ;;.11;;1
  1.  ;;.12;;2