IBQLPOST ;LEB/MRY - CREATE IBQ ROLLUP MAILGROUP POST INT ;5-JUL-95
;;1.0;UTILIZATION MGMT ROLLUP LOCAL;;Oct 01, 1995
;;Per VHA Directive 10-93-142, this routine should not be modified.
;
;
% N X,Y,I,J,DA,DR,DIC,DIE,DIK,IB,DIFROM,DLAYGO
D DT^DICRW
D INDEX,MAILGRP
W !,"<<< Post init completed!"
G END
;
INDEX ; -- Index field #1.17 ACUTE CARE DISCHARGE DATE of File 356.1.
W !!,"Indexing field #1.17 ACUTE CARE DISCHARGE DATE of File #356.1."
W !,"working...."
S DIK="^IBT(356.1,",DIK(1)="1.17" D ENALL^DIK
W !,"<<< Re-indexing complete!"
Q
;
MAILGRP ; -- Stuff in new mail group
W !!,"Creating new Mailgroup IBQ ROLLUP"
W !!,*7,"<<< Please add members to IBQ ROLLUP after install! >>>"
N A,B,C,D,E,F
S A="IBQ ROLLUP",B=0,C=.5,D=0,G=1
I $D(^XMB(3.8,"B",A)) G END
S E(DUZ)=""
S F(1)="This mail group will automatically alert UR persons that entries"
S F(2)="are ready for/or received transmition."
S X="XMBGRP" X ^%ZOSF("TEST") S IBT=$T
W !!,"<<< Adding mail group "_A,!
I IBT S X=$$MG^XMBGRP(A,B,C,D,.E,.F,G)
I 'IBT D
.; -- environment pre-init check for Mailman 7.1 should not allow the
.; following lines to display.
.W !,"<<< Earlier version then Mailman 7.1 on your system! >>>"
.W !,"<<< create a mailgroup named IBQ ROLLUP and add members! >>>"
Q
;
END K DLAYGO
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBQLPOST 1352 printed Dec 13, 2024@02:41:23 Page 2
IBQLPOST ;LEB/MRY - CREATE IBQ ROLLUP MAILGROUP POST INT ;5-JUL-95
+1 ;;1.0;UTILIZATION MGMT ROLLUP LOCAL;;Oct 01, 1995
+2 ;;Per VHA Directive 10-93-142, this routine should not be modified.
+3 ;
+4 ;
% NEW X,Y,I,J,DA,DR,DIC,DIE,DIK,IB,DIFROM,DLAYGO
+1 DO DT^DICRW
+2 DO INDEX
DO MAILGRP
+3 WRITE !,"<<< Post init completed!"
+4 GOTO END
+5 ;
INDEX ; -- Index field #1.17 ACUTE CARE DISCHARGE DATE of File 356.1.
+1 WRITE !!,"Indexing field #1.17 ACUTE CARE DISCHARGE DATE of File #356.1."
+2 WRITE !,"working...."
+3 SET DIK="^IBT(356.1,"
SET DIK(1)="1.17"
DO ENALL^DIK
+4 WRITE !,"<<< Re-indexing complete!"
+5 QUIT
+6 ;
MAILGRP ; -- Stuff in new mail group
+1 WRITE !!,"Creating new Mailgroup IBQ ROLLUP"
+2 WRITE !!,*7,"<<< Please add members to IBQ ROLLUP after install! >>>"
+3 NEW A,B,C,D,E,F
+4 SET A="IBQ ROLLUP"
SET B=0
SET C=.5
SET D=0
SET G=1
+5 IF $DATA(^XMB(3.8,"B",A))
GOTO END
+6 SET E(DUZ)=""
+7 SET F(1)="This mail group will automatically alert UR persons that entries"
+8 SET F(2)="are ready for/or received transmition."
+9 SET X="XMBGRP"
XECUTE ^%ZOSF("TEST")
SET IBT=$TEST
+10 WRITE !!,"<<< Adding mail group "_A,!
+11 IF IBT
SET X=$$MG^XMBGRP(A,B,C,D,.E,.F,G)
+12 IF 'IBT
Begin DoDot:1
+13 ; -- environment pre-init check for Mailman 7.1 should not allow the
+14 ; following lines to display.
+15 WRITE !,"<<< Earlier version then Mailman 7.1 on your system! >>>"
+16 WRITE !,"<<< create a mailgroup named IBQ ROLLUP and add members! >>>"
End DoDot:1
+17 QUIT
+18 ;
END KILL DLAYGO
+1 QUIT
