| 1 | A1B2PST ;ALB/MJK - ODS Post Init ; 14 JAN 1991
|
|---|
| 2 | ;;Version 1.55 (local for MAS v5 sites);;
|
|---|
| 3 | ;
|
|---|
| 4 | EN ; -- entry point to run post-init
|
|---|
| 5 | D DEL
|
|---|
| 6 | Q
|
|---|
| 7 | ;
|
|---|
| 8 | MG ; -- add confirmation mail group
|
|---|
| 9 | S DIC="^XMB(3.8,",DIC(0)="L",DIC("DR")="4////PU;5////"_DUZ,X="ODS CONFIRMATION" D ^DIC K DIC
|
|---|
| 10 | G MGQ:'$P(Y,U,3)
|
|---|
| 11 | S ^XMB(3.8,+Y,2,0)="^^2^2^2900625^"
|
|---|
| 12 | S ^XMB(3.8,+Y,2,1,0)="This mail group will receive confirmation messages from ODS National Rollup"
|
|---|
| 13 | S ^XMB(3.8,+Y,2,2,0)="Database System."
|
|---|
| 14 | W !!,">>> New 'ODS CONFIRMATION' confirmation mail group added..."
|
|---|
| 15 | MGQ Q
|
|---|
| 16 | ;
|
|---|
| 17 | ;
|
|---|
| 18 | DIEZ ; -- compile input templates
|
|---|
| 19 | ;
|
|---|
| 20 | W !!,">>> Will now compile three DG and SD input templates affected"
|
|---|
| 21 | W !," by this package (3 templates)..."
|
|---|
| 22 | K A1B2LINE S U="^",$P(A1B2LINE,"=",81)="",A1B2MAX=^DD("ROU")
|
|---|
| 23 | 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
|
|---|
| 24 | W !!,*7,">>> Also, please use the 'Recompile HINQ templates' option"
|
|---|
| 25 | W !," to recompile the 'DVBHINQ UPDATE' input template."
|
|---|
| 26 | ;
|
|---|
| 27 | K A1B20,A1B2X,A1B2MAX,A1B2EMP,DGI,A1B2LINE Q
|
|---|
| 28 | ;
|
|---|
| 29 | POS ; -- add ODS period of service
|
|---|
| 30 | S X="OPERATION DESERT SHIELD",DIC="^DIC(21,",DIC(0)="ML"
|
|---|
| 31 | 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"
|
|---|
| 32 | D ^DIC K DIC
|
|---|
| 33 | I Y<1 W !,*7,">>> Could not add 'OPERATION DESERT SHIELD' Period of Service." Q
|
|---|
| 34 | I $P(Y,U,3) W !,">>> 'OPERATION DESERT SHIELD (Code: 6)' Period of Service has been added."
|
|---|
| 35 | Q
|
|---|
| 36 | ;
|
|---|
| 37 | PAR ; -- set up parameter file entry
|
|---|
| 38 | Q:$D(^A1B2(11500.5,1,0))
|
|---|
| 39 | S Y=$O(^DIC(4.2,"B","ISC-ALBANY.VA.GOV",0))
|
|---|
| 40 | S DIC(0)="L",X=1,DIC="^A1B2(11500.5,",DIC("DR")=".02////0;.06////"_Y
|
|---|
| 41 | D ^DIC K DIC
|
|---|
| 42 | I $P(Y,U,3) W !!,">>> ODS PARAMETER file entry added."
|
|---|
| 43 | Q
|
|---|
| 44 | ;
|
|---|
| 45 | DEL ; -- call to remove delete routines
|
|---|
| 46 | I '$D(^%ZOSF("DEL")) W !,"^%ZOSF(""DEL"") does not exist" G QD
|
|---|
| 47 | ASK W !!,">>> This routine will permanantly remove the routines:"
|
|---|
| 48 | W !," A1B2NAT"
|
|---|
| 49 | W !," A1B2P1",!
|
|---|
| 50 | W !," WARNING: If either of the listed routines are mapped, they"
|
|---|
| 51 | W !," must first be removed from the mapped set to avoid"
|
|---|
| 52 | W !," further complications!",!
|
|---|
| 53 | 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
|
|---|
| 54 | W !,"Routine deletion starting..."
|
|---|
| 55 | F A1B2X="A1B2NAT","A1B2P1" S X=A1B2X X ^%ZOSF("TEST") I $T W !?5,"...removing ",X X ^%ZOSF("DEL")
|
|---|
| 56 | W !,"Routine deletion completed."
|
|---|
| 57 | QD K A1B2X,X,% Q
|
|---|
| 58 | ;
|
|---|
| 59 | BOS ; -- check Branch of Service entries
|
|---|
| 60 | ;
|
|---|
| 61 | W !!,">>> Will now check entries in your 'Branch of Service' file..."
|
|---|
| 62 | S E=0,DOTS=". . . . . . . . . . ."
|
|---|
| 63 | 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
|
|---|
| 64 | I E W !!," You should use VA FileMan to enter/edit missing branches."
|
|---|
| 65 | K I,E,X,Y,DOTS Q
|
|---|
| 66 | ;
|
|---|
| 67 | NAMES ; -- BOS names
|
|---|
| 68 | ;;AIR FORCE
|
|---|
| 69 | ;;ARMY
|
|---|
| 70 | ;;COAST GUARD
|
|---|
| 71 | ;;MARINE CORPS
|
|---|
| 72 | ;;NAVY
|
|---|
| 73 | ;;NOAA
|
|---|
| 74 | ;;USPHS
|
|---|
| 75 | ;;$END
|
|---|
