INHVAM.m

INHVAM(UIF,ERROR) ;JSH-DGH; 8 Jul 94 11:22;Transceiver for MDIS messages

 ;;3.01;BHL IHS Interfaces with GIS;;JUL 01, 2001

 ;COPYRIGHT 1991-2000 SAIC

 ;

 ;INPUT:

 ;  UIF   - ien in Universal Interface file (#4001)

 ;  ERROR - array to contain any error message(s)

 ;OUPTUT:

 ;  ERROR - array of error message(s)

 ;  function value - status of transmission

 ;     [  0 - successful ;  1 - failure ]

 ;

 ;First, set an entry in the MDIS MESSAGE EXCHANGE FILE

 N DIC,DLAYGO,%,LCT,INZ,LINE,DIK,DA

 S X=$$NOW^UTDT("S"),DIC="^INVAM(",DIC(0)="L",DLAYGO=4095 D ^DICN

 I Y<0 S ERROR(1)="Unable to create entry in MDIS MESSAGE FILE" Q 1

 S INZ=+Y L +^INVAM(INZ)

 S (%,LCT)=0 F  D GETLINE^INHOU(UIF,.LCT,.LINE) Q:'$D(LINE)  D

 . ;copy main line

 . S %=%+1,^INVAM(INZ,1,%,0)=LINE

 . ;Copy overflow nodes

 . F I=1:1 Q:'$D(LINE(I))  S ^INVAM(INZ,1,%+I,0)=LINE(I)

 . S %=%+I-1,^INVAM(INZ,1,%,0)=^INVAM(INZ,1,%,0)_$C(13)

 ;set message terminator

 S %=%+1,^INVAM(INZ,1,%,0)=$C(28)_$C(13)

 S ^INVAM(INZ,1,0)=U_U_%_U_%

 S $P(^INVAM(INZ,0),U,4)=0

 ;Cross-reference the entry

 S DA=INZ,DIK="^INVAM(" D IX1^DIK

 ;Unlock and quit

 L -^INVAM(INZ) Q 0

 ;

AUTOP ;Autopurge of messages

 ;Default retention period is 14 DAYS

 S INDAYS=14 G ZTPUR

 Q

 ;

PURGE ;Purge entries in ^INVAM

 N INDAYS,X,ZTIO,ZTRTN,ZTSAVE,ZTDESC,ZTSK

 W !,"Purge messages from the MDIS/CHCS MESSAGE EXCHANGE file (^INVAM)",!

 W ! D ^UTSRD("Number of days to keep transactions: ;;;;14;7,60")

 Q:X=""!(X[U)  S INDAYS=+X

 S ZTIO="",ZTRTN="ZTPUR^INHVAM",ZTSAVE("INDAYS")="",ZTDESC="Purge MDIS messages"

 D ^%ZTLOAD W !,"Request",$S($G(ZTSK):" ",1:" NOT "),"queued"

 Q

 ;

ZTPUR ;Taskman entry point

 Q:$G(INDAYS)<3

 S X1=DT,X2=-INDAYS D C^%DTC S INDAYS=+X

 S DIK="^INVAM(",INX=0,INCOUNT=0

 F  S INX=$O(^INVAM(INX)) Q:'INX  I +$G(^INVAM(INX,0))<INDAYS S DA=INX D ^DIK,HANG

 Q

 ;

HANG ;Limit entries deleted to 11,000 per hour

 S INCOUNT=INCOUNT+1 Q:INCOUNT<3  S INCOUNT=0 H 1

 Q

 ;

INHVAM(UIF,ERROR) ;JSH-DGH; 8 Jul 94 11:22;Transceiver for MDIS messages

 +1       ;;3.01;BHL IHS Interfaces with GIS;;JUL 01, 2001

 +2       ;COPYRIGHT 1991-2000 SAIC

 +3       ;

 +4       ;INPUT:

 +5       ;  UIF   - ien in Universal Interface file (#4001)

 +6       ;  ERROR - array to contain any error message(s)

 +7       ;OUPTUT:

 +8       ;  ERROR - array of error message(s)

 +9       ;  function value - status of transmission

 +10      ;     [  0 - successful ;  1 - failure ]

 +11      ;

 +12      ;First, set an entry in the MDIS MESSAGE EXCHANGE FILE

 +13       NEW DIC,DLAYGO,%,LCT,INZ,LINE,DIK,DA

 +14       SET X=$$NOW^UTDT("S")

           SET DIC="^INVAM("

           SET DIC(0)="L"

           SET DLAYGO=4095

           DO ^DICN

 +15       IF Y<0

               SET ERROR(1)="Unable to create entry in MDIS MESSAGE FILE"

               QUIT 1

 +16       SET INZ=+Y

           LOCK +^INVAM(INZ)

 +17       SET (%,LCT)=0

           FOR 

               DO GETLINE^INHOU(UIF,.LCT,.LINE)

               IF '$DATA(LINE)

                   QUIT 

               Begin DoDot:1

 +18      ;copy main line

 +19               SET %=%+1

                   SET ^INVAM(INZ,1,%,0)=LINE

 +20      ;Copy overflow nodes

 +21               FOR I=1:1

                       IF '$DATA(LINE(I))

                           QUIT 

                       SET ^INVAM(INZ,1,%+I,0)=LINE(I)

 +22               SET %=%+I-1

                   SET ^INVAM(INZ,1,%,0)=^INVAM(INZ,1,%,0)_$CHAR(13)

               End DoDot:1

 +23      ;set message terminator

 +24       SET %=%+1

           SET ^INVAM(INZ,1,%,0)=$CHAR(28)_$CHAR(13)

 +25       SET ^INVAM(INZ,1,0)=U_U_%_U_%

 +26       SET $PIECE(^INVAM(INZ,0),U,4)=0

 +27      ;Cross-reference the entry

 +28       SET DA=INZ

           SET DIK="^INVAM("

           DO IX1^DIK

 +29      ;Unlock and quit

 +30       LOCK -^INVAM(INZ)

           QUIT 0

 +31      ;

AUTOP     ;Autopurge of messages

 +1       ;Default retention period is 14 DAYS

 +2        SET INDAYS=14

           GOTO ZTPUR

 +3        QUIT 

 +4       ;

PURGE     ;Purge entries in ^INVAM

 +1        NEW INDAYS,X,ZTIO,ZTRTN,ZTSAVE,ZTDESC,ZTSK

 +2        WRITE !,"Purge messages from the MDIS/CHCS MESSAGE EXCHANGE file (^INVAM)",!

 +3        WRITE !

           DO ^UTSRD("Number of days to keep transactions: ;;;;14;7,60")

 +4        IF X=""!(X[U)

               QUIT 

           SET INDAYS=+X

 +5        SET ZTIO=""

           SET ZTRTN="ZTPUR^INHVAM"

           SET ZTSAVE("INDAYS")=""

           SET ZTDESC="Purge MDIS messages"

 +6        DO ^%ZTLOAD

           WRITE !,"Request",$SELECT($GET(ZTSK):" ",1:" NOT "),"queued"

 +7        QUIT 

 +8       ;

ZTPUR     ;Taskman entry point

 +1        IF $GET(INDAYS)<3

               QUIT 

 +2        SET X1=DT

           SET X2=-INDAYS

           DO C^%DTC

           SET INDAYS=+X

 +3        SET DIK="^INVAM("

           SET INX=0

           SET INCOUNT=0

 +4        FOR 

               SET INX=$ORDER(^INVAM(INX))

               IF 'INX

                   QUIT 

               IF +$GET(^INVAM(INX,0))<INDAYS

                   SET DA=INX

                   DO ^DIK

                   DO HANG

 +5        QUIT 

 +6       ;

HANG      ;Limit entries deleted to 11,000 per hour

 +1        SET INCOUNT=INCOUNT+1

           IF INCOUNT<3

               QUIT 

           SET INCOUNT=0

           HANG 1

 +2        QUIT 

 +3       ;