source: FOIAVistA/tag/r/QUALITY_ASSURANCE_INTEGRATION-QAQ/QAQSELCT.m@ 628

QAQSELCT ;HISC/DAD-GENERIC FILE ENTRY SELECTOR ;2/11/94  12:29
 ;;1.7;QM Integration Module;;07/25/1995
 ;
 ;*** SELECTS A GROUP OF RECORDS FROM A FILE ***
 ;
 ;REQUIRES:
 ;  QAQDIC      = FILE NUMBER OR GLOBAL ROOT
 ;  QAQDIC(0)   = DIC(0) STRING
 ;  QAQUTIL     = NODE TO STORE DATA UNDER IN ^UTILITY($J,QAQUTIL,
 ;OPTIONAL:
 ;  QAQDIC("A") = DIC("A") STRING
 ;  QAQDIC("B") = DIC("B") STRING
 ;  QAQDIC("S") = DIC("S") STRING
 ;  QAQDIC("W") = DIC("W") STRING
 ;RETURNS:
 ;  QAQQUIT     = $S(UP_ARROW_OUT:1 , NOTHING_SELECTED:1 , 1:0)
 ;  ^UTILITY($J,QAQUTIL,EXTERNAL_.01_FIELD_DATA,IEN) = ""
EN1 ;
 S QAQQUIT=0 I ($D(QAQDIC)[0)!($D(QAQDIC(0))[0)!($D(QAQUTIL)[0) S QAQQUIT=1 G EXIT
 I (QAQDIC="")!(QAQDIC(0)="")!(QAQUTIL="") S QAQQUIT=1 G EXIT
 D K S DIC=QAQDIC I DIC S (QAQDIC,DIC)=$S($D(^DIC(DIC,0,"GL"))#2:^("GL"),1:"") I DIC="" S QAQQUIT=1 G EXIT
 S DIC(0)=QAQDIC(0),DIC(0)=$TR(DIC(0),"AL") S:DIC(0)'["Z" DIC(0)=DIC(0)_"Z" S QAQDIC(0)=DIC(0)
 D DO^DIC1 S QAQFNUM=+DO(2),QAQFNAME=$P(DO,"^"),QAQFLD01=$P(^DD(QAQFNUM,.01,0),"^"),QAQFSCR=$S($D(DO("SCR"))#2:DO("SCR"),1:"") K DO
 S QAQFLD01("S")=QAQFLD01_$S($E(QAQFLD01,$L(QAQFLD01))?1L:"s",1:"S")
 F X="A","B","S","W" S QAQDIC(X)=$S($D(QAQDIC(X))#2:QAQDIC(X),1:"")
 S:QAQDIC("A")="" QAQDIC("A")="Select "_QAQFNAME_" "_QAQFLD01_": "
 S QAQALL=0,QAQNUM=1 K ^UTILITY($J,QAQUTIL) D HOME^%ZIS
1 D SETDIC W !!,$S(QAQNUM>1:"Another one: ",1:DIC("A")),$S((QAQNUM=1)&(QAQDIC("B")]""):QAQDIC("B")_"// ",1:"")
 R X:DTIME S:('$T)!($E(X)="^") QAQQUIT=1 G:QAQQUIT EXIT S:(QAQNUM=1)&(X="")&(QAQDIC("B")]"") X=QAQDIC("B") G:X="" EXIT S QAQDSEL=$S(X?1"-"1.E:1,1:0) S:QAQDSEL X=$E(X,2,$L(X))
 I $L(X),$L(X)<4,"Aa"[$E(X),"Ll"[$E(X,2),"Ll"[$E(X,3) D ALL G EXIT:QAQQUIT,1:QAQALL
 D HELP:$E(X)="?",^DIC K DIC G:+Y'>0 1
 I $$CHKFLD(QAQFNUM)["D" D
 . N %DT,X
 . S QAQD0=Y,X=Y(0,0),%DT="ST" D ^%DT S Y(0,0)=Y,Y=QAQD0
 . Q
 I 'QAQDSEL,'$D(^UTILITY($J,QAQUTIL,$E(Y(0,0),1,63),+Y)) S ^(+Y)="",QAQNUM=QAQNUM+1
 I QAQDSEL,$D(^UTILITY($J,QAQUTIL,$E(Y(0,0),1,63),+Y)) K ^(+Y) S QAQNUM=QAQNUM-$S(QAQNUM>0:1,1:0)
 G 1
EXIT ;
 S QAQQUIT=$S(QAQQUIT:1,$O(^UTILITY($J,QAQUTIL,""))="":1,1:0) K QAQDIC,QAQUTIL
K K %,C,D0,DA,DIC,DIK,DIR,DO,QAQ,QAQALL,QAQD0,QAQDSEL,QAQDT,QAQFLD01,QAQFNAME,QAQFNUM,QAQFSCR,QAQLINE,QAQNUM,X,Y
 Q
ALL ;
 S QAQ="By '"_X_"' do you mean all "_$S($G(QAQFSCR)]"":"",$G(QAQDIC("S"))]"":"",1:$P(@(QAQDIC_"0)"),"^",4)_" ")_QAQFNAME_" "_QAQFLD01("S") D WRAP
 S %=1 D YN^DICN S QAQALL=$S(%=1:1,1:0) S:%=-1 QAQQUIT=1 I '% W !?7,"Answer Y(es) if you want all of the ",QAQFLD01("S"),",",!?7,"otherwise answer N(o)" G ALL
 I QAQQUIT!'QAQALL W:'QAQQUIT !!,X Q
 N X F QAQD0=0:0 S QAQD0=$O(@(QAQDIC_"QAQD0)")) Q:QAQD0'>0  D AL
 W:QAQNUM=1 " ??",*7
 Q
AL I QAQFSCR]"" D SETDIC I $D(@(QAQDIC_"QAQD0,0)"))#2 S (D0,DA,Y)=QAQD0 X QAQFSCR Q:'$T
 I QAQDIC("S")]"" D SETDIC I $D(@(QAQDIC_"QAQD0,0)"))#2 S (D0,DA,Y)=QAQD0 X DIC("S") Q:'$T
 S Y=$P($G(@(QAQDIC_"QAQD0,0)")),"^"),C=$P(^DD(QAQFNUM,.01,0),"^",2) Q:Y=""
 D Y^DIQ
 I $$CHKFLD(QAQFNUM)["D" D
 . N %DT,X
 . S X=Y,%DT="ST" D ^%DT
 . Q
 S ^UTILITY($J,QAQUTIL,$E(Y,1,63),QAQD0)="",QAQNUM=QAQNUM+1
 Q
HELP ;
 N X S QAQ="Select a "_QAQFNAME_" "_QAQFLD01_" from the displayed list." D WRAP
 W !?5,"To deselect a ",QAQFLD01," type a minus sign (-)",!?5,"in front of it, e.g.  -",QAQFLD01,".",!?5,"To get all ",QAQFLD01("S")," type ALL."
 G:$O(^UTILITY($J,QAQUTIL,""))="" HLP
SHOW S QAQLINE=$Y,QAQ="" W !!,"You have already selected:"
 F  S QAQ=$O(^UTILITY($J,QAQUTIL,QAQ)) Q:QAQ=""!QAQQUIT  F QAQD0=0:0 S QAQD0=$O(^UTILITY($J,QAQUTIL,QAQ,QAQD0)) Q:QAQD0'>0!QAQQUIT  D SHO
HLP W ! S QAQQUIT=0
 Q
SHO S QAQ(0)=QAQ
 I $$CHKFLD(QAQFNUM)["D" D
 . N Y
 . S Y=QAQ(0) X ^DD("DD") S QAQ(0)=Y
 . Q
 I QAQDIC(0)["N" W !?3,QAQD0,?15,QAQ(0)
 E  W !?3,QAQ(0)
 D SETDIC I $D(DIC("W"))#2,DIC("W")]"",$D(@(QAQDIC_"QAQD0,0)"))#2 S (D0,DA,Y)=QAQD0 X DIC("W")
 I $Y>(IOSL+QAQLINE-3) D PAUSE S QAQLINE=$Y
 Q
WRAP ;
 W ! F  S Y=$L($E(QAQ,1,IOM-20)," ") W !?5,$P(QAQ," ",1,Y) S QAQ=$P(QAQ," ",Y+1,999) Q:QAQ=""
 Q
PAUSE ;
 K DIR S DIR(0)="E" D ^DIR K DIR S QAQQUIT=$S(Y:0,1:1)
 Q
SETDIC ;
 K DIC,DO S DIC=QAQDIC
 F X="0","A","B","S","W" I QAQDIC(X)]"" S DIC(X)=QAQDIC(X)
 D DO^DIC1
 Q
CHKFLD(X) ;
 N A S A=$P($G(^DD(X,.01,0)),"^",2)
 I A["P" F  S A=$$CHKFLD($TR(A,$TR(A,".0123456789"))) Q:A'["P"
 Q A