A1B2PST ;ALB/MJK - ODS Post Init ; 14 JAN 1991
;;Version 1.55 (local for MAS v5 sites);;
;
EN ; -- entry point to run post-init
D DEL
Q
;
MG ; -- add confirmation mail group
S DIC="^XMB(3.8,",DIC(0)="L",DIC("DR")="4////PU;5////"_DUZ,X="ODS CONFIRMATION" D ^DIC K DIC
G MGQ:'$P(Y,U,3)
S ^XMB(3.8,+Y,2,0)="^^2^2^2900625^"
S ^XMB(3.8,+Y,2,1,0)="This mail group will receive confirmation messages from ODS National Rollup"
S ^XMB(3.8,+Y,2,2,0)="Database System."
W !!,">>> New 'ODS CONFIRMATION' confirmation mail group added..."
MGQ Q
;
;
DIEZ ; -- compile input templates
;
W !!,">>> Will now compile three DG and SD input templates affected"
W !," by this package (3 templates)..."
K A1B2LINE S U="^",$P(A1B2LINE,"=",81)="",A1B2MAX=^DD("ROU")
F A1B2X="DGADM","DGADMASIH","SDM1" S Y=+$O(^DIE("B",A1B2X,0)) I $D(^DIE(Y,"ROUOLD")),^("ROUOLD")]"",$D(^(0)) S X=$P(^("ROUOLD"),"^"),DMAX=A1B2MAX D EN^DIEZ W !!,A1B2LINE
W !!,*7,">>> Also, please use the 'Recompile HINQ templates' option"
W !," to recompile the 'DVBHINQ UPDATE' input template."
;
K A1B20,A1B2X,A1B2MAX,A1B2EMP,DGI,A1B2LINE Q
;
POS ; -- add ODS period of service
S X="OPERATION DESERT SHIELD",DIC="^DIC(21,",DIC(0)="ML"
S DIC("DR")=".02////ODS;.03////6;.04////2910115;.06////W;.07///1973;20////ACTIVE DUTY FROM ODS;10///OTHER FEDERAL AGENCY;15///ODS;.08////1"
D ^DIC K DIC
I Y<1 W !,*7,">>> Could not add 'OPERATION DESERT SHIELD' Period of Service." Q
I $P(Y,U,3) W !,">>> 'OPERATION DESERT SHIELD (Code: 6)' Period of Service has been added."
Q
;
PAR ; -- set up parameter file entry
Q:$D(^A1B2(11500.5,1,0))
S Y=$O(^DIC(4.2,"B","ISC-ALBANY.DOMAIN.EXT",0))
S DIC(0)="L",X=1,DIC="^A1B2(11500.5,",DIC("DR")=".02////0;.06////"_Y
D ^DIC K DIC
I $P(Y,U,3) W !!,">>> ODS PARAMETER file entry added."
Q
;
DEL ; -- call to remove delete routines
I '$D(^%ZOSF("DEL")) W !,"^%ZOSF(""DEL"") does not exist" G QD
ASK W !!,">>> This routine will permanantly remove the routines:"
W !," A1B2NAT"
W !," A1B2P1",!
W !," WARNING: If either of the listed routines are mapped, they"
W !," must first be removed from the mapped set to avoid"
W !," further complications!",!
W !,"Are you sure you want to continue" S %=2 D YN^DICN G QD:%=-1!(%=2) I '% W !?5,"Respond 'Y'es or 'N'o" G ASK
W !,"Routine deletion starting..."
F A1B2X="A1B2NAT","A1B2P1" S X=A1B2X X ^%ZOSF("TEST") I $T W !?5,"...removing ",X X ^%ZOSF("DEL")
W !,"Routine deletion completed."
QD K A1B2X,X,% Q
;
BOS ; -- check Branch of Service entries
;
W !!,">>> Will now check entries in your 'Branch of Service' file..."
S E=0,DOTS=". . . . . . . . . . ."
F I=1:1 S X=$P($T(NAMES+I),";",3) Q:X="$END" W !?10,X,$E(DOTS,1,25-$L(X)) S Y=$O(^DIC(23,"B",X,0)) W $S($D(^DIC(23,+Y,0)):"",1:"not "),"present" I 'E,'$D(^DIC(23,+Y,0)) S E=1
I E W !!," You should use VA FileMan to enter/edit missing branches."
K I,E,X,Y,DOTS Q
;
NAMES ; -- BOS names
;;AIR FORCE
;;ARMY
;;COAST GUARD
;;MARINE CORPS
;;NAVY
;;NOAA
;;USPHS
;;$END
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HA1B2PST 3128 printed Oct 16, 2024@18:22:06 Page 2
A1B2PST ;ALB/MJK - ODS Post Init ; 14 JAN 1991
+1 ;;Version 1.55 (local for MAS v5 sites);;
+2 ;
EN ; -- entry point to run post-init
+1 DO DEL
+2 QUIT
+3 ;
MG ; -- add confirmation mail group
+1 SET DIC="^XMB(3.8,"
SET DIC(0)="L"
SET DIC("DR")="4////PU;5////"_DUZ
SET X="ODS CONFIRMATION"
DO ^DIC
KILL DIC
+2 if '$PIECE(Y,U,3)
GOTO MGQ
+3 SET ^XMB(3.8,+Y,2,0)="^^2^2^2900625^"
+4 SET ^XMB(3.8,+Y,2,1,0)="This mail group will receive confirmation messages from ODS National Rollup"
+5 SET ^XMB(3.8,+Y,2,2,0)="Database System."
+6 WRITE !!,">>> New 'ODS CONFIRMATION' confirmation mail group added..."
MGQ QUIT
+1 ;
+2 ;
DIEZ ; -- compile input templates
+1 ;
+2 WRITE !!,">>> Will now compile three DG and SD input templates affected"
+3 WRITE !," by this package (3 templates)..."
+4 KILL A1B2LINE
SET U="^"
SET $PIECE(A1B2LINE,"=",81)=""
SET A1B2MAX=^DD("ROU")
+5 FOR A1B2X="DGADM","DGADMASIH","SDM1"
SET Y=+$ORDER(^DIE("B",A1B2X,0))
IF $DATA(^DIE(Y,"ROUOLD"))
IF ^("ROUOLD")]""
IF $DATA(^(0))
SET X=$PIECE(^("ROUOLD"),"^")
SET DMAX=A1B2MAX
DO EN^DIEZ
WRITE !!,A1B2LINE
+6 WRITE !!,*7,">>> Also, please use the 'Recompile HINQ templates' option"
+7 WRITE !," to recompile the 'DVBHINQ UPDATE' input template."
+8 ;
+9 KILL A1B20,A1B2X,A1B2MAX,A1B2EMP,DGI,A1B2LINE
QUIT
+10 ;
POS ; -- add ODS period of service
+1 SET X="OPERATION DESERT SHIELD"
SET DIC="^DIC(21,"
SET DIC(0)="ML"
+2 SET DIC("DR")=".02////ODS;.03////6;.04////2910115;.06////W;.07///1973;20////ACTIVE DUTY FROM ODS;10///OTHER FEDERAL AGENCY;15///ODS;.08////1"
+3 DO ^DIC
KILL DIC
+4 IF Y<1
WRITE !,*7,">>> Could not add 'OPERATION DESERT SHIELD' Period of Service."
QUIT
+5 IF $PIECE(Y,U,3)
WRITE !,">>> 'OPERATION DESERT SHIELD (Code: 6)' Period of Service has been added."
+6 QUIT
+7 ;
PAR ; -- set up parameter file entry
+1 if $DATA(^A1B2(11500.5,1,0))
QUIT
+2 SET Y=$ORDER(^DIC(4.2,"B","ISC-ALBANY.DOMAIN.EXT",0))
+3 SET DIC(0)="L"
SET X=1
SET DIC="^A1B2(11500.5,"
SET DIC("DR")=".02////0;.06////"_Y
+4 DO ^DIC
KILL DIC
+5 IF $PIECE(Y,U,3)
WRITE !!,">>> ODS PARAMETER file entry added."
+6 QUIT
+7 ;
DEL ; -- call to remove delete routines
+1 IF '$DATA(^%ZOSF("DEL"))
WRITE !,"^%ZOSF(""DEL"") does not exist"
GOTO QD
ASK WRITE !!,">>> This routine will permanantly remove the routines:"
+1 WRITE !," A1B2NAT"
+2 WRITE !," A1B2P1",!
+3 WRITE !," WARNING: If either of the listed routines are mapped, they"
+4 WRITE !," must first be removed from the mapped set to avoid"
+5 WRITE !," further complications!",!
+6 WRITE !,"Are you sure you want to continue"
SET %=2
DO YN^DICN
if %=-1!(%=2)
GOTO QD
IF '%
WRITE !?5,"Respond 'Y'es or 'N'o"
GOTO ASK
+7 WRITE !,"Routine deletion starting..."
+8 FOR A1B2X="A1B2NAT","A1B2P1"
SET X=A1B2X
XECUTE ^%ZOSF("TEST")
IF $TEST
WRITE !?5,"...removing ",X
XECUTE ^%ZOSF("DEL")
+9 WRITE !,"Routine deletion completed."
QD KILL A1B2X,X,%
QUIT
+1 ;
BOS ; -- check Branch of Service entries
+1 ;
+2 WRITE !!,">>> Will now check entries in your 'Branch of Service' file..."
+3 SET E=0
SET DOTS=". . . . . . . . . . ."
+4 FOR I=1:1
SET X=$PIECE($TEXT(NAMES+I),";",3)
if X="$END"
QUIT
WRITE !?10,X,$EXTRACT(DOTS,1,25-$LENGTH(X))
SET Y=$ORDER(^DIC(23,"B",X,0))
WRITE $SELECT($DATA(^DIC(23,+Y,0)):"",1:"not "),"present"
IF 'E
IF '$DATA(^DIC(23,+Y,0))
SET E=1
+5 IF E
WRITE !!," You should use VA FileMan to enter/edit missing branches."
+6 KILL I,E,X,Y,DOTS
QUIT
+7 ;
NAMES ; -- BOS names
+1 ;;AIR FORCE
+2 ;;ARMY
+3 ;;COAST GUARD
+4 ;;MARINE CORPS
+5 ;;NAVY
+6 ;;NOAA
+7 ;;USPHS
+8 ;;$END
