source: WorldVistAEHR/trunk/r/UTILIZATION_MGMT_ROLLUP_LOCAL-IBQ/IBQLPOST.m@ 1800

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

initial load of WorldVistAEHR

File size: 1.3 KB
RevLine 
[613]1IBQLPOST ;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 ;
12INDEX ; -- 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 ;
19MAILGRP ; -- 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 ;
38END K DLAYGO
39 Q
Note: See TracBrowser for help on using the repository browser.