QAQAPGRP ;HISC/DAD-LOAD\UNLOAD APPLICATION GROUPS ;9/3/93 13:17
;;1.7;QM Integration Module;;07/25/1995
K DIC S DIC="^DIC(9.4,",DIC(0)="AEMNQZ" D ^DIC K DIC G:Y'>0 EXIT S QAQANMSP=$P(Y(0),"^",2)
EN1 ; *** Package Entry Point
;
; Requires: QAQANMSP = Package namespace
; Optional: QAQAPROG = $TEXT routine (DO @QAQAPROG)
; Entry point to build list of default files
; in ^UTILITY($J,"QAQA",File#) = File_Name.
; Format: [TAG^]ROUTINE (TAG and ^ optional)
;
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")
W !!,"Checking the ",QAQANMSP," application group"
I $D(QAQAPROG)#2,QAQAPROG]"" S:QAQAPROG'["^" QAQAPROG="^"_QAQAPROG S X=$P(QAQAPROG,"^",2) X ^%ZOSF("TEST") I D @QAQAPROG
F QAFILE=0:0 S QAFILE=$O(^DIC("AC",QAQANMSP,QAFILE)) Q:QAFILE'>0 S ^UTILITY($J,"QAQA",QAFILE)=$P(^DIC(QAFILE,0),"^") W "."
ASK ;
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
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),"^")
I QADELETE D
. I $D(^UTILITY($J,"QAQA",QAFILE))[0 W " ??",*7 Q
. S ^UTILITY($J,"QAQA DEL",QAFILE)=QAFILE(0)
. K ^UTILITY($J,"QAQA",QAFILE)
. Q
E S ^UTILITY($J,"QAQA",QAFILE)=QAFILE(0) K ^UTILITY($J,"QAQA DEL",QAFILE)
G ASK
OK ;
I $O(^UTILITY($J,"QAQA",0))'>0,$O(^UTILITY($J,"QAQA DEL",0))'>0 W !!?3,"*** No files selected !! ***",*7 G EXIT
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
W !!,"Loading:" I $O(^UTILITY($J,"QAQA",0)) D
. F QAFILE=0:0 S QAFILE=$O(^UTILITY($J,"QAQA",QAFILE)) Q:QAFILE'>0 D
.. K DD,DIC,DINUM,DO
.. S:$D(^DIC(QAFILE,"%",0))[0 ^(0)="^1.005^^"
.. S DA(1)=QAFILE,DIC="^DIC("_QAFILE_",""%"",",DIC(0)="L"
.. S X=QAQANMSP D:$O(^DIC("AC",QAQANMSP,QAFILE,0))'>0 FILE^DICN
.. W !?3,QAFILE,?15,^UTILITY($J,"QAQA",QAFILE)
.. Q
. Q
E W !?3,"*** None ***"
W !!,"Unloading:" I $O(^UTILITY($J,"QAQA DEL",0)) D
. F QAFILE=0:0 S QAFILE=$O(^UTILITY($J,"QAQA DEL",QAFILE)) Q:QAFILE'>0 D
.. F QAQDA=0:0 S QAQDA=$O(^DIC("AC",QAQANMSP,QAFILE,QAQDA)) Q:QAQDA'>0 D
... S DA(1)=QAFILE,DIK="^DIC("_QAFILE_",""%"",",DA=QAQDA
... D ^DIK
... Q
.. W !?3,QAFILE,?15,^UTILITY($J,"QAQA DEL",QAFILE)
.. Q
. Q
E W !?3,"*** None ***"
W !!,"*** Finished ***",*7
EXIT ;
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")
Q
HELP ;
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"
W !!,"Files selected for LOADING:" S QALIST="QAQA" D HLP
W !!,"Files selected for UNLOADING:" S QALIST="QAQA DEL" D HLP
Q:X'?1"??".E K DIR S DIR(0)="E" W ! D ^DIR K DIR Q:Y'>0
S DIC="^DIC(",DIC(0)="AEMNQ",DIC("S")="I Y'<2",D="B",DZ="??" D DQ^DICQ
Q
HLP N X I $O(^UTILITY($J,QALIST,0)) D
. S QALINE=$Y,Y=1
. F QAFILE=0:0 S QAFILE=$O(^UTILITY($J,QALIST,QAFILE)) Q:(QAFILE'>0)!(Y'>0) D
.. W !?3,QAFILE,?15,^UTILITY($J,QALIST,QAFILE),?65
.. W "(",$S($D(^DIC("AC",QAQANMSP,QAFILE)):"Loaded",1:"Not Loaded"),")"
.. I $Y>(IOSL+QALINE-3) K DIR S DIR(0)="E",QALINE=$Y D ^DIR K DIR
.. Q
. Q
E W !?3,"*** None ***"
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HQAQAPGRP 3462 printed Nov 22, 2024@17:41:21 Page 2
QAQAPGRP ;HISC/DAD-LOAD\UNLOAD APPLICATION GROUPS ;9/3/93 13:17
+1 ;;1.7;QM Integration Module;;07/25/1995
+2 KILL DIC
SET DIC="^DIC(9.4,"
SET DIC(0)="AEMNQZ"
DO ^DIC
KILL DIC
if Y'>0
GOTO EXIT
SET QAQANMSP=$PIECE(Y(0),"^",2)
EN1 ; *** Package Entry Point
+1 ;
+2 ; Requires: QAQANMSP = Package namespace
+3 ; Optional: QAQAPROG = $TEXT routine (DO @QAQAPROG)
+4 ; Entry point to build list of default files
+5 ; in ^UTILITY($J,"QAQA",File#) = File_Name.
+6 ; Format: [TAG^]ROUTINE (TAG and ^ optional)
+7 ;
+8 if $SELECT($DATA(QAQANMSP)[0:1,QAQANMSP="":1,QAQANMSP'?.U:1,$LENGTH(QAQANMSP)+1\3-1:1,1:0)
GOTO EXIT
KILL ^UTILITY($JOB,"QAQA"),^UTILITY($JOB,"QAQA DEL")
+9 WRITE !!,"Checking the ",QAQANMSP," application group"
+10 IF $DATA(QAQAPROG)#2
IF QAQAPROG]""
if QAQAPROG'["^"
SET QAQAPROG="^"_QAQAPROG
SET X=$PIECE(QAQAPROG,"^",2)
XECUTE ^%ZOSF("TEST")
IF $TEST
DO @QAQAPROG
+11 FOR QAFILE=0:0
SET QAFILE=$ORDER(^DIC("AC",QAQANMSP,QAFILE))
if QAFILE'>0
QUIT
SET ^UTILITY($JOB,"QAQA",QAFILE)=$PIECE(^DIC(QAFILE,0),"^")
WRITE "."
ASK ;
+1 READ !!,"Select FILE: ",X:DTIME
if '$TEST
SET X="^"
if $EXTRACT(X)="^"
GOTO EXIT
if X=""
GOTO OK
SET QADELETE=($EXTRACT(X)="-")
SET X=$SELECT(QADELETE:$EXTRACT(X,2,999),1:X)
IF $EXTRACT(X)="?"
DO HELP
GOTO ASK
+2 SET DIC="^DIC("
SET DIC(0)="EMNQZ"
SET DIC("S")="I Y'<2"
DO ^DIC
KILL DIC
if Y'>0
GOTO ASK
SET QAFILE=+Y
SET QAFILE(0)=$PIECE(Y(0),"^")
+3 IF QADELETE
Begin DoDot:1
+4 IF $DATA(^UTILITY($JOB,"QAQA",QAFILE))[0
WRITE " ??",*7
QUIT
+5 SET ^UTILITY($JOB,"QAQA DEL",QAFILE)=QAFILE(0)
+6 KILL ^UTILITY($JOB,"QAQA",QAFILE)
+7 QUIT
End DoDot:1
+8 IF '$TEST
SET ^UTILITY($JOB,"QAQA",QAFILE)=QAFILE(0)
KILL ^UTILITY($JOB,"QAQA DEL",QAFILE)
+9 GOTO ASK
OK ;
+1 IF $ORDER(^UTILITY($JOB,"QAQA",0))'>0
IF $ORDER(^UTILITY($JOB,"QAQA DEL",0))'>0
WRITE !!?3,"*** No files selected !! ***",*7
GOTO EXIT
+2 WRITE !!,"Load / Unload application groups"
SET %=2
DO YN^DICN
if (%=-1)!(%=2)
GOTO EXIT
IF '%
WRITE !!?5,"Please answer Y(es) or N(o)"
GOTO OK
+3 WRITE !!,"Loading:"
IF $ORDER(^UTILITY($JOB,"QAQA",0))
Begin DoDot:1
+4 FOR QAFILE=0:0
SET QAFILE=$ORDER(^UTILITY($JOB,"QAQA",QAFILE))
if QAFILE'>0
QUIT
Begin DoDot:2
+5 KILL DD,DIC,DINUM,DO
+6 if $DATA(^DIC(QAFILE,"%",0))[0
SET ^(0)="^1.005^^"
+7 SET DA(1)=QAFILE
SET DIC="^DIC("_QAFILE_",""%"","
SET DIC(0)="L"
+8 SET X=QAQANMSP
if $ORDER(^DIC("AC",QAQANMSP,QAFILE,0))'>0
DO FILE^DICN
+9 WRITE !?3,QAFILE,?15,^UTILITY($JOB,"QAQA",QAFILE)
+10 QUIT
End DoDot:2
+11 QUIT
End DoDot:1
+12 IF '$TEST
WRITE !?3,"*** None ***"
+13 WRITE !!,"Unloading:"
IF $ORDER(^UTILITY($JOB,"QAQA DEL",0))
Begin DoDot:1
+14 FOR QAFILE=0:0
SET QAFILE=$ORDER(^UTILITY($JOB,"QAQA DEL",QAFILE))
if QAFILE'>0
QUIT
Begin DoDot:2
+15 FOR QAQDA=0:0
SET QAQDA=$ORDER(^DIC("AC",QAQANMSP,QAFILE,QAQDA))
if QAQDA'>0
QUIT
Begin DoDot:3
+16 SET DA(1)=QAFILE
SET DIK="^DIC("_QAFILE_",""%"","
SET DA=QAQDA
+17 DO ^DIK
+18 QUIT
End DoDot:3
+19 WRITE !?3,QAFILE,?15,^UTILITY($JOB,"QAQA DEL",QAFILE)
+20 QUIT
End DoDot:2
+21 QUIT
End DoDot:1
+22 IF '$TEST
WRITE !?3,"*** None ***"
+23 WRITE !!,"*** Finished ***",*7
EXIT ;
+1 KILL %,D,DA,DIC,DIE,DIK,DIR,DR,DZ,QA,QADELETE,QAFILE,QALINE,QALIST,QAQANMSP,QAQAPROG,X,Y,^UTILITY($JOB,"QAQA"),^UTILITY($JOB,"QAQA DEL")
+2 QUIT
HELP ;
+1 WRITE !!," 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"
+2 WRITE !!,"Files selected for LOADING:"
SET QALIST="QAQA"
DO HLP
+3 WRITE !!,"Files selected for UNLOADING:"
SET QALIST="QAQA DEL"
DO HLP
+4 if X'?1"??".E
QUIT
KILL DIR
SET DIR(0)="E"
WRITE !
DO ^DIR
KILL DIR
if Y'>0
QUIT
+5 SET DIC="^DIC("
SET DIC(0)="AEMNQ"
SET DIC("S")="I Y'<2"
SET D="B"
SET DZ="??"
DO DQ^DICQ
+6 QUIT
HLP NEW X
IF $ORDER(^UTILITY($JOB,QALIST,0))
Begin DoDot:1
+1 SET QALINE=$Y
SET Y=1
+2 FOR QAFILE=0:0
SET QAFILE=$ORDER(^UTILITY($JOB,QALIST,QAFILE))
if (QAFILE'>0)!(Y'>0)
QUIT
Begin DoDot:2
+3 WRITE !?3,QAFILE,?15,^UTILITY($JOB,QALIST,QAFILE),?65
+4 WRITE "(",$SELECT($DATA(^DIC("AC",QAQANMSP,QAFILE)):"Loaded",1:"Not Loaded"),")"
+5 IF $Y>(IOSL+QALINE-3)
KILL DIR
SET DIR(0)="E"
SET QALINE=$Y
DO ^DIR
KILL DIR
+6 QUIT
End DoDot:2
+7 QUIT
End DoDot:1
+8 IF '$TEST
WRITE !?3,"*** None ***"
+9 QUIT
