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