1 | IBQLPOST ;LEB/MRY - CREATE IBQ ROLLUP MAILGROUP POST INT ;5-JUL-95
|
---|
2 | ;;1.0;UTILIZATION MGMT ROLLUP LOCAL;;Oct 01, 1995
|
---|
3 | ;;Per VHA Directive 10-93-142, this routine should not be modified.
|
---|
4 | ;
|
---|
5 | ;
|
---|
6 | % N X,Y,I,J,DA,DR,DIC,DIE,DIK,IB,DIFROM,DLAYGO
|
---|
7 | D DT^DICRW
|
---|
8 | D INDEX,MAILGRP
|
---|
9 | W !,"<<< Post init completed!"
|
---|
10 | G END
|
---|
11 | ;
|
---|
12 | INDEX ; -- Index field #1.17 ACUTE CARE DISCHARGE DATE of File 356.1.
|
---|
13 | W !!,"Indexing field #1.17 ACUTE CARE DISCHARGE DATE of File #356.1."
|
---|
14 | W !,"working...."
|
---|
15 | S DIK="^IBT(356.1,",DIK(1)="1.17" D ENALL^DIK
|
---|
16 | W !,"<<< Re-indexing complete!"
|
---|
17 | Q
|
---|
18 | ;
|
---|
19 | MAILGRP ; -- Stuff in new mail group
|
---|
20 | W !!,"Creating new Mailgroup IBQ ROLLUP"
|
---|
21 | W !!,*7,"<<< Please add members to IBQ ROLLUP after install! >>>"
|
---|
22 | N A,B,C,D,E,F
|
---|
23 | S A="IBQ ROLLUP",B=0,C=.5,D=0,G=1
|
---|
24 | I $D(^XMB(3.8,"B",A)) G END
|
---|
25 | S E(DUZ)=""
|
---|
26 | S F(1)="This mail group will automatically alert UR persons that entries"
|
---|
27 | S F(2)="are ready for/or received transmition."
|
---|
28 | S X="XMBGRP" X ^%ZOSF("TEST") S IBT=$T
|
---|
29 | W !!,"<<< Adding mail group "_A,!
|
---|
30 | I IBT S X=$$MG^XMBGRP(A,B,C,D,.E,.F,G)
|
---|
31 | I 'IBT D
|
---|
32 | .; -- environment pre-init check for Mailman 7.1 should not allow the
|
---|
33 | .; following lines to display.
|
---|
34 | .W !,"<<< Earlier version then Mailman 7.1 on your system! >>>"
|
---|
35 | .W !,"<<< create a mailgroup named IBQ ROLLUP and add members! >>>"
|
---|
36 | Q
|
---|
37 | ;
|
---|
38 | END K DLAYGO
|
---|
39 | Q
|
---|