source: WorldVistAEHR/trunk/r/IFCAP-PRC-PRX--PRCA--PRCN/PRCP5PRE.m@ 619

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

initial load of WorldVistAEHR

File size: 2.3 KB
Line 
1PRCP5PRE ;WISC/RFJ-pre init for inventory version 5 ;29 Jun 94
2 ;;5.0;IFCAP;;4/21/95
3 ;
4 ;
5START ; start pre init to delete all PRCP options (except PRCPZ)
6 N %,DA,DIK,DIU,MENUDA,MENUDA1,PRCPDA,PRCPOPT,X
7 K X S X(1)="This pre-init to the Generic Inventory Package will delete all PRCP options (except PRCPZ) from the OPTION file. It will also clean up all menu pointers which reference the deleted PRCP options."
8 S X(2)="The pre-init to the Generic Inventory Package will also delete all PRCP input templates, sort templates, and print templates except the PRCPZ namespaced entries." D DISPLAY^PRCPUX2(1,78,.X)
9 ;
10 W ! S PRCPOPT="PRCP" F S PRCPOPT=$O(^DIC(19,"B",PRCPOPT)) Q:$E(PRCPOPT,1,4)'="PRCP"!($E(PRCPOPT,1,5)="PRCPZ") S PRCPDA=0 F S PRCPDA=$O(^DIC(19,"B",PRCPOPT,PRCPDA)) Q:'PRCPDA D
11 . I PRCPOPT="PRCP MAIN MENU"!(PRCPOPT="PRCP2 MAIN MENU")!(PRCPOPT="PRCPW MAIN MENU")!(PRCPOPT="PRCP ALL") Q
12 . ; do not delete queued taskman options
13 . I PRCPOPT="PRCP OPEN BALANCES TASKMAN SET"!(PRCPOPT="PRCP PURGE AUTOMATIC RUN") Q
14 . W !," deleting option: ",PRCPOPT
15 . ; clean up menus first
16 . S MENUDA=0 F S MENUDA=$O(^DIC(19,"AD",PRCPDA,MENUDA)) Q:'MENUDA S MENUDA1=0 F S MENUDA1=$O(^DIC(19,"AD",PRCPDA,MENUDA,MENUDA1)) Q:'MENUDA1 D
17 . . N DA,DIK S DIK="^DIC(19,"_MENUDA_",10,",DA(1)=MENUDA,DA=MENUDA1 D ^DIK Q
18 . ; remove option
19 . S DIK="^DIC(19,",DA=PRCPDA D ^DIK W " deleted!"
20 ;
21 ; delete input, sort, and print templates
22 W !!,"deleting INPUT TEMPLATES:" S PRCPOPT="PRCP" F S PRCPOPT=$O(^DIE("B",PRCPOPT)) Q:$E(PRCPOPT,1,4)'="PRCP"!($E(PRCPOPT,1,5)="PRCPZ") S PRCPDA=0 F S PRCPDA=$O(^DIE("B",PRCPOPT,PRCPDA)) Q:'PRCPDA D
23 . W !?9,PRCPOPT S DIK="^DIE(",DA=PRCPDA D ^DIK W " deleted!"
24 W !!,"deleting SORT TEMPLATES:" S PRCPOPT="PRCP" F S PRCPOPT=$O(^DIBT("B",PRCPOPT)) Q:$E(PRCPOPT,1,4)'="PRCP"!($E(PRCPOPT,1,5)="PRCPZ") S PRCPDA=0 F S PRCPDA=$O(^DIBT("B",PRCPOPT,PRCPDA)) Q:'PRCPDA D
25 . W !?9,PRCPOPT S DIK="^DIBT(",DA=PRCPDA D ^DIK W " deleted!"
26 W !!,"deleting PRINT TEMPLATES:" S PRCPOPT="PRCP" F S PRCPOPT=$O(^DIPT("B",PRCPOPT)) Q:$E(PRCPOPT,1,4)'="PRCP"!($E(PRCPOPT,1,5)="PRCPZ") S PRCPDA=0 F S PRCPDA=$O(^DIPT("B",PRCPOPT,PRCPDA)) Q:'PRCPDA D
27 . W !?9,PRCPOPT S DIK="^DIPT(",DA=PRCPDA D ^DIK W " deleted!"
28 ;
29 ; clean inventory dd field descriptions
30 D DESCRIP^PRC5INS1(445,447)
31 W !!
32 Q
Note: See TracBrowser for help on using the repository browser.