IBQLPOST.m

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 ---IBQLPOST   1352     printed  Apr 09, 2024@21:43:13                                                                                                                                                                                                    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