| [613] | 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 | 
|---|