A1B2SUP ;ALB/MJK - ODS Supervisor Options; JAN 13,1991
;;Version 1.55 (local for MAS v5 sites);;
;
;
EN D DT^DICRW S X=$T(+1),DIK="^DOPT(""A1B2SUP"","
G A:$D(^DOPT("A1B2SUP",5))
S ^DOPT("A1B2SUP",0)="ODS Supervisor Options^1N^"
F I=1:1 S Y=$T(@I) Q:Y="" S ^DOPT("A1B2SUP",I,0)=$P(Y,";",3,99)
D IXALL^DIK
;
A W !! S DIC="^DOPT(""A1B2SUP"",",DIC(0)="IQEAM"
D ^DIC Q:Y<0 D @+Y G A
;
1 ;;Activate ODS Software
D ASK G Q1:'Y
D FAC^A1B2UTL
S A1B2POS=+$O(^DIC(21,"D",6,0)) S:'$D(^DIC(21,A1B2POS,0)) A1B2POS=0
I 'A1B2POS!('A1B2FN) D MES G Q1
D BOS^A1B2PST W !
S DR="[A1B2 PARAMETERS]",DIE="^A1B2(11500.5,",DA=1 D ^DIE G Q1:'$P(^A1B2(11500.5,1,0),U,2)
I $P(^DIC(21,A1B2POS,0),U,8) S DIE="^DIC(21,",DR=".08///@",DA=A1B2POS D ^DIE
D OPT
Q1 K A1B2POS,A1B2FN,A1B2FNE,DQ,DE,DR,DIE,DQ Q
;
OPT ; -- ask questins to set-up background job to run nightly
W !!,">>> Please enter date/time for the 'A1B2 BACKGROUND JOB' option to run:"
S DA=$O(^DIC(19,"B","A1B2 BACKGROUND JOB",0)),DR="200//T+1@2AM;202///1D",DIE="^DIC(19," D ^DIE
W !,">>> This job does NOT require an output device."
Q
;
2 ;;Compile and Transmit ODS Data
D QUEUE^A1B2BGJ
Q
;
3 ;;ODS System Inquiry
D ^A1B2STAT
Q
;
MES ;; -- can't swith on software
W !!,*7,">>>> ODS software CANNOT be activated:"
W:'A1B2FN !," o Medical Center Division file entry '",$O(^DG(40.8,0)),"' does not point"
W:'A1B2FN !," to an Institution file entry that has a Facility number"
W:'A1B2FN !," defined."
W:'A1B2POS !!," o ODS Period of Service does NOT exist on your system."
Q
;
ASK ; -- ask are they sure
; -- don't show message if flag is already on
I '$D(^A1B2(11500.5,1,0)) S Y=0 G ASKQ
S Y=$P(^A1B2(11500.5,1,0),U,2) G ASKQ:Y
W !!?20,"******* P L E A S E N O T E *******"
W !!?5,"Do NOT activate this Operation Desert Shield (ODS) software"
W !?5,"until directed to by Central Office in Washington D.C."
W !?5,"This software will only be activated in the event that it becomes"
W !?5,"necessary for the VA to track ODS casualties."
W !!?5,"With the software deactivated, the MAS application will"
W !?5,"operate normally. When activated, various ODS related"
W !?5,"questions will appear during the registration, admit and"
W !?5,"discharge processes.",!
S DIR("A")="Are you sure you wish to continue",DIR(0)="Y",DIR("B")="NO"
D ^DIR K DIR Q
ASKQ Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HA1B2SUP 2430 printed Apr 09, 2024@21:23:53 Page 2
A1B2SUP ;ALB/MJK - ODS Supervisor Options; JAN 13,1991
+1 ;;Version 1.55 (local for MAS v5 sites);;
+2 ;
+3 ;
EN DO DT^DICRW
SET X=$TEXT(+1)
SET DIK="^DOPT(""A1B2SUP"","
+1 if $DATA(^DOPT("A1B2SUP",5))
GOTO A
+2 SET ^DOPT("A1B2SUP",0)="ODS Supervisor Options^1N^"
+3 FOR I=1:1
SET Y=$TEXT(@I)
if Y=""
QUIT
SET ^DOPT("A1B2SUP",I,0)=$PIECE(Y,";",3,99)
+4 DO IXALL^DIK
+5 ;
A WRITE !!
SET DIC="^DOPT(""A1B2SUP"","
SET DIC(0)="IQEAM"
+1 DO ^DIC
if Y<0
QUIT
DO @+Y
GOTO A
+2 ;
1 ;;Activate ODS Software
+1 DO ASK
if 'Y
GOTO Q1
+2 DO FAC^A1B2UTL
+3 SET A1B2POS=+$ORDER(^DIC(21,"D",6,0))
if '$DATA(^DIC(21,A1B2POS,0))
SET A1B2POS=0
+4 IF 'A1B2POS!('A1B2FN)
DO MES
GOTO Q1
+5 DO BOS^A1B2PST
WRITE !
+6 SET DR="[A1B2 PARAMETERS]"
SET DIE="^A1B2(11500.5,"
SET DA=1
DO ^DIE
if '$PIECE(^A1B2(11500.5,1,0),U,2)
GOTO Q1
+7 IF $PIECE(^DIC(21,A1B2POS,0),U,8)
SET DIE="^DIC(21,"
SET DR=".08///@"
SET DA=A1B2POS
DO ^DIE
+8 DO OPT
Q1 KILL A1B2POS,A1B2FN,A1B2FNE,DQ,DE,DR,DIE,DQ
QUIT
+1 ;
OPT ; -- ask questins to set-up background job to run nightly
+1 WRITE !!,">>> Please enter date/time for the 'A1B2 BACKGROUND JOB' option to run:"
+2 SET DA=$ORDER(^DIC(19,"B","A1B2 BACKGROUND JOB",0))
SET DR="200//T+1@2AM;202///1D"
SET DIE="^DIC(19,"
DO ^DIE
+3 WRITE !,">>> This job does NOT require an output device."
+4 QUIT
+5 ;
2 ;;Compile and Transmit ODS Data
+1 DO QUEUE^A1B2BGJ
+2 QUIT
+3 ;
3 ;;ODS System Inquiry
+1 DO ^A1B2STAT
+2 QUIT
+3 ;
MES ;; -- can't swith on software
+1 WRITE !!,*7,">>>> ODS software CANNOT be activated:"
+2 if 'A1B2FN
WRITE !," o Medical Center Division file entry '",$ORDER(^DG(40.8,0)),"' does not point"
+3 if 'A1B2FN
WRITE !," to an Institution file entry that has a Facility number"
+4 if 'A1B2FN
WRITE !," defined."
+5 if 'A1B2POS
WRITE !!," o ODS Period of Service does NOT exist on your system."
+6 QUIT
+7 ;
ASK ; -- ask are they sure
+1 ; -- don't show message if flag is already on
+2 IF '$DATA(^A1B2(11500.5,1,0))
SET Y=0
GOTO ASKQ
+3 SET Y=$PIECE(^A1B2(11500.5,1,0),U,2)
if Y
GOTO ASKQ
+4 WRITE !!?20,"******* P L E A S E N O T E *******"
+5 WRITE !!?5,"Do NOT activate this Operation Desert Shield (ODS) software"
+6 WRITE !?5,"until directed to by Central Office in Washington D.C."
+7 WRITE !?5,"This software will only be activated in the event that it becomes"
+8 WRITE !?5,"necessary for the VA to track ODS casualties."
+9 WRITE !!?5,"With the software deactivated, the MAS application will"
+10 WRITE !?5,"operate normally. When activated, various ODS related"
+11 WRITE !?5,"questions will appear during the registration, admit and"
+12 WRITE !?5,"discharge processes.",!
+13 SET DIR("A")="Are you sure you wish to continue"
SET DIR(0)="Y"
SET DIR("B")="NO"
+14 DO ^DIR
KILL DIR
QUIT
ASKQ QUIT
