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