source: WorldVistAEHR/trunk/r/OPERATIONS_WITH_DESERT_STORM-A1B2/A1B2PST.m@ 699

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

initial load of WorldVistAEHR

File size: 3.0 KB
Line 
1A1B2PST ;ALB/MJK - ODS Post Init ; 14 JAN 1991
2 ;;Version 1.55 (local for MAS v5 sites);;
3 ;
4EN ; -- entry point to run post-init
5 D DEL
6 Q
7 ;
8MG ; -- 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..."
15MGQ Q
16 ;
17 ;
18DIEZ ; -- 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 ;
29POS ; -- 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 ;
37PAR ; -- 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 ;
45DEL ; -- call to remove delete routines
46 I '$D(^%ZOSF("DEL")) W !,"^%ZOSF(""DEL"") does not exist" G QD
47ASK 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."
57QD K A1B2X,X,% Q
58 ;
59BOS ; -- 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 ;
67NAMES ; -- BOS names
68 ;;AIR FORCE
69 ;;ARMY
70 ;;COAST GUARD
71 ;;MARINE CORPS
72 ;;NAVY
73 ;;NOAA
74 ;;USPHS
75 ;;$END
Note: See TracBrowser for help on using the repository browser.