source: WorldVistAEHR/trunk/r/QUALITY_ASSURANCE_INTEGRATION-QAQ/QAQAPGRP.m@ 701

Last change on this file since 701 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 3.3 KB
Line 
1QAQAPGRP ;HISC/DAD-LOAD\UNLOAD APPLICATION GROUPS ;9/3/93 13:17
2 ;;1.7;QM Integration Module;;07/25/1995
3 K DIC S DIC="^DIC(9.4,",DIC(0)="AEMNQZ" D ^DIC K DIC G:Y'>0 EXIT S QAQANMSP=$P(Y(0),"^",2)
4EN1 ; *** Package Entry Point
5 ;
6 ; Requires: QAQANMSP = Package namespace
7 ; Optional: QAQAPROG = $TEXT routine (DO @QAQAPROG)
8 ; Entry point to build list of default files
9 ; in ^UTILITY($J,"QAQA",File#) = File_Name.
10 ; Format: [TAG^]ROUTINE (TAG and ^ optional)
11 ;
12 G EXIT:$S($D(QAQANMSP)[0:1,QAQANMSP="":1,QAQANMSP'?.U:1,$L(QAQANMSP)+1\3-1:1,1:0) K ^UTILITY($J,"QAQA"),^UTILITY($J,"QAQA DEL")
13 W !!,"Checking the ",QAQANMSP," application group"
14 I $D(QAQAPROG)#2,QAQAPROG]"" S:QAQAPROG'["^" QAQAPROG="^"_QAQAPROG S X=$P(QAQAPROG,"^",2) X ^%ZOSF("TEST") I D @QAQAPROG
15 F QAFILE=0:0 S QAFILE=$O(^DIC("AC",QAQANMSP,QAFILE)) Q:QAFILE'>0 S ^UTILITY($J,"QAQA",QAFILE)=$P(^DIC(QAFILE,0),"^") W "."
16ASK ;
17 R !!,"Select FILE: ",X:DTIME S:'$T X="^" G EXIT:$E(X)="^",OK:X="" S QADELETE=($E(X)="-"),X=$S(QADELETE:$E(X,2,999),1:X) I $E(X)="?" D HELP G ASK
18 S DIC="^DIC(",DIC(0)="EMNQZ",DIC("S")="I Y'<2" D ^DIC K DIC G:Y'>0 ASK S QAFILE=+Y,QAFILE(0)=$P(Y(0),"^")
19 I QADELETE D
20 . I $D(^UTILITY($J,"QAQA",QAFILE))[0 W " ??",*7 Q
21 . S ^UTILITY($J,"QAQA DEL",QAFILE)=QAFILE(0)
22 . K ^UTILITY($J,"QAQA",QAFILE)
23 . Q
24 E S ^UTILITY($J,"QAQA",QAFILE)=QAFILE(0) K ^UTILITY($J,"QAQA DEL",QAFILE)
25 G ASK
26OK ;
27 I $O(^UTILITY($J,"QAQA",0))'>0,$O(^UTILITY($J,"QAQA DEL",0))'>0 W !!?3,"*** No files selected !! ***",*7 G EXIT
28 W !!,"Load / Unload application groups" S %=2 D YN^DICN G:(%=-1)!(%=2) EXIT I '% W !!?5,"Please answer Y(es) or N(o)" G OK
29 W !!,"Loading:" I $O(^UTILITY($J,"QAQA",0)) D
30 . F QAFILE=0:0 S QAFILE=$O(^UTILITY($J,"QAQA",QAFILE)) Q:QAFILE'>0 D
31 .. K DD,DIC,DINUM,DO
32 .. S:$D(^DIC(QAFILE,"%",0))[0 ^(0)="^1.005^^"
33 .. S DA(1)=QAFILE,DIC="^DIC("_QAFILE_",""%"",",DIC(0)="L"
34 .. S X=QAQANMSP D:$O(^DIC("AC",QAQANMSP,QAFILE,0))'>0 FILE^DICN
35 .. W !?3,QAFILE,?15,^UTILITY($J,"QAQA",QAFILE)
36 .. Q
37 . Q
38 E W !?3,"*** None ***"
39 W !!,"Unloading:" I $O(^UTILITY($J,"QAQA DEL",0)) D
40 . F QAFILE=0:0 S QAFILE=$O(^UTILITY($J,"QAQA DEL",QAFILE)) Q:QAFILE'>0 D
41 .. F QAQDA=0:0 S QAQDA=$O(^DIC("AC",QAQANMSP,QAFILE,QAQDA)) Q:QAQDA'>0 D
42 ... S DA(1)=QAFILE,DIK="^DIC("_QAFILE_",""%"",",DA=QAQDA
43 ... D ^DIK
44 ... Q
45 .. W !?3,QAFILE,?15,^UTILITY($J,"QAQA DEL",QAFILE)
46 .. Q
47 . Q
48 E W !?3,"*** None ***"
49 W !!,"*** Finished ***",*7
50EXIT ;
51 K %,D,DA,DIC,DIE,DIK,DIR,DR,DZ,QA,QADELETE,QAFILE,QALINE,QALIST,QAQANMSP,QAQAPROG,X,Y,^UTILITY($J,"QAQA"),^UTILITY($J,"QAQA DEL")
52 Q
53HELP ;
54 W !!," Enter a file name/number to add a file to the list",!," Enter a minus (-) file name/number to remove a file from the list"
55 W !!,"Files selected for LOADING:" S QALIST="QAQA" D HLP
56 W !!,"Files selected for UNLOADING:" S QALIST="QAQA DEL" D HLP
57 Q:X'?1"??".E K DIR S DIR(0)="E" W ! D ^DIR K DIR Q:Y'>0
58 S DIC="^DIC(",DIC(0)="AEMNQ",DIC("S")="I Y'<2",D="B",DZ="??" D DQ^DICQ
59 Q
60HLP N X I $O(^UTILITY($J,QALIST,0)) D
61 . S QALINE=$Y,Y=1
62 . F QAFILE=0:0 S QAFILE=$O(^UTILITY($J,QALIST,QAFILE)) Q:(QAFILE'>0)!(Y'>0) D
63 .. W !?3,QAFILE,?15,^UTILITY($J,QALIST,QAFILE),?65
64 .. W "(",$S($D(^DIC("AC",QAQANMSP,QAFILE)):"Loaded",1:"Not Loaded"),")"
65 .. I $Y>(IOSL+QALINE-3) K DIR S DIR(0)="E",QALINE=$Y D ^DIR K DIR
66 .. Q
67 . Q
68 E W !?3,"*** None ***"
69 Q
Note: See TracBrowser for help on using the repository browser.