source: FOIAVistA/trunk/r/PHARMACY_PRESCRIPTION_PRACTICE-PPP/PPPAPOST.m@ 1336

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

initial load of FOIAVistA 6/30/08 version
File size: 4.0 KB
Line 
1PPPAPOST ;BIRMFO/DAD - Post Init Routine for Patch 2 ; 2/1/96
2 ;;V1.0;PHARMACY PRESCRIPTION PRACTICE;**2**;APR 7,1995
3 ;
4 ;deleting menu options logfile and xref
5 F POPT=$O(^DIC(19,"B","PPP PURGE LOGFILE",0)),$O(^DIC(19,"B","PPP XREF PURGE",0)) I POPT D
6 .S DFN=$O(^DIC(19,"B","PPP MAIN",0)),IFN=0
7 .F S IFN=$O(^DIC(19,DFN,10,IFN)) Q:'IFN I $P(^DIC(19,DFN,10,IFN,0),"^")=POPT D
8 ..S DR=".01////@",DA(1)=DFN,DIE="^DIC(19,"_DA(1)_",10,",DA=IFN D ^DIE
9 K DIE,DA,X,Y,DIC,DR
10 ;creating ppp merged site edit option
11 ;
12 W !!,"Creating the following options:",!!?5,"PPP MERGED SITE EDIT...",!
13 S DIC="^DIC(19,",DIC(0)="L",X="PPP MERGED SITE EDIT",DIC("DR")="1////Add/Edit Merged Sites;4////R;3////PPP UTIL;12////PHARMACY PRESCRIPTION PRACTICE;25////EDITSITE^PPPPDX1" K DD,DO D:'$O(^DIC(19,"B","PPP MERGED SITE EDIT",0))
14 .D FILE^DICN
15 .S X=$O(^DIC(19,"B","PPP MERGED SITE EDIT",0)),FLAG=0,OPTION=X,IFN=0 K DIC,DD,DO
16 .F S IFN=$O(^DIC(19,DFN,10,IFN)) Q:'IFN I $P(^DIC(19,DFN,10,IFN,0),"^")=OPTION
17 .D:'FLAG
18 ..S DA(1)=DFN,DIC="^DIC(19,"_DA(1)_",10,",DIC(0)="L",DIC("DR")="2////CONS" K DD,DO D FILE^DICN K DIC,X ;adds to PPP main menu
19 K DIE,DA,X,Y,DIC,DR
20 ;create logfile and xref background options
21 W !?5,"PPP BACKGROUND PURGE LOGFILE...",!
22 W !?5,"PPP BACKGROUND PURGE XREF...",!
23 F X="PPP BACKGROUND PURGE LOGFILE","PPP BACKGROUND PURGE XREF" D
24 .S DIC="^DIC(19,",DIC(0)="L",ROUTINE=$S(X="PPP BACKGROUND PURGE LOGFILE":"LOG1^PPPPURG",1:"XREF^PPPPURG")
25 .S DIC("DR")="1////"_$S(X="PPP BACKGROUND PURGE LOGFILE":"Background Purge Logfile",1:"Purge Other Facility Xref")_";4////R;3////PPP UTIL;12////PHARMACY PRESCRIPTION PRACTICE;25////"_ROUTINE
26 .K DD,DO D:'$O(^DIC(19,"B",X,0)) FILE^DICN K DIC,X
27 K DIE,DA,X,Y,DIC,DR
28 ;
29 ;creating logfile and xref sub menus
30 ;
31 W !?5,"PPP PURGE LOGFILE MENU...",!
32 W !?5,"PPP PURGE XREF MENU...",!
33 F X="PPP PURGE LOGFILE MENU","PPP PURGE XREF MENU" D
34 .S DIC="^DIC(19,",DIC(0)="L"
35 .S DIC("DR")="1////"_$S(X="PPP PURGE LOGFILE MENU":"Purge Logfile Menu",1:"Purge Xref Menu")_";4////M;3////PPP UTIL;12////PHARMACY PRESCRIPTION PRACTICE"
36 .K DD,DO D:'$O(^DIC(19,"B",X,0)) FILE^DICN K DIC
37 K DIE,DA,X,Y,DIC,DR
38 ;
39 ;create xref and logfile "init" jobs and add to sub menus
40 ;
41 W !?5,"PPP INIT PURGE LOGFILE JOB...",!
42 W !?5,"PPP INIT PURGE XREF JOB...",!
43 S DIC="^DIC(19,",DIC(0)="L",X="PPP INIT PURGE LOGFILE JOB",DIC("DR")="1////Initialize Logfile Purge;4////R;3////PPP UTIL;12////PHARMACY PRESCRIPTION PRACTICE;25////SETUP1^PPPPURG"
44 K DD,DO D:'$O(^DIC(19,"B","PPP INIT PURGE LOGFILE JOB",0)) FILE^DICN
45 K DIC,X,DR,DIE,DIC,DA S IFN=0
46 F OPT=$O(^DIC(19,"B","PPP INIT PURGE LOGFILE JOB",0)),$O(^DIC(19,"B","PPP PURGE LOGFILE",0)) D
47 .S DR=".01////"_OPT_";2////"_$S($P(^DIC(19,OPT,0),"^")="PPP INIT PURGE LOGFILE JOB":"BPRG",1:"LPRG")
48 .S IFN=IFN+1,DA=IFN
49 .S DA(1)=$O(^DIC(19,"B","PPP PURGE LOGFILE MENU",0)),^DIC(19,DA(1),10,0)="^19.01IP^2^2"
50 .S DIE="^DIC(19,"_DA(1)_",10," D ^DIE K DR,DIE,DA
51 ;
52 S DIC="^DIC(19,",DIC(0)="L",X="PPP INIT PURGE XREF JOB",DIC("DR")="1////Initialize Xref Purge;4////R;3////PPP UTIL;12////PHARMACY PRESCRIPTION PRACTICE;25////SETUP2^PPPPURG"
53 K DD,DO D:'$O(^DIC(19,"B","PPP INIT PURGE XREF JOB",0)) FILE^DICN
54 ;
55 K DIC,X,DR,DIE,DIC,DA S IFN=0
56 F OPT=$O(^DIC(19,"B","PPP INIT PURGE XREF JOB",0)),$O(^DIC(19,"B","PPP XREF PURGE",0)) D
57 .S DR=".01////"_OPT_";2////"_$S($P(^DIC(19,OPT,0),"^")="PPP INIT PURGE XREF JOB":"BPRG",1:"LPRG")
58 .S IFN=IFN+1,DA=IFN
59 .S DA(1)=$O(^DIC(19,"B","PPP PURGE XREF MENU",0)),^DIC(19,DA(1),10,0)="^19.01IP^2^2"
60 .S DIE="^DIC(19,"_DA(1)_",10," D ^DIE K DR,DIE,DA
61 ;
62 ;add logfile and xref menu to ppp main menu
63 ;
64 S COUNT=0
65 F OPTS=$O(^DIC(19,"B","PPP PURGE LOGFILE MENU",0)),$O(^DIC(19,"B","PPP PURGE XREF MENU",0)) I OPTS S VAR=0,COUNT=COUNT+1 D
66 .S DFN=$O(^DIC(19,"B","PPP MAIN",0)),IFN=0
67 .F S IFN=$O(^DIC(19,DFN,10,IFN)) Q:'IFN I $P(^DIC(19,DFN,10,IFN,0),"^")=OPTS S VAR=1
68 .D:'VAR
69 ..S SYN=$S(COUNT=1:"LPRG",1:"XPRG")
70 ..S X=OPTS K DIC,DD,DO S DA(1)=DFN,DIC="^DIC(19,"_DA(1)_",10,",DIC(0)="L",DIC("DR")="2////"_SYN K DD,DO D FILE^DICN K DIC,X
71 K COUNT,DFN,FLAG,IFN,OPT,OPTION,OPTS,POPT,ROUTINE,SYN,VAR
Note: See TracBrowser for help on using the repository browser.