HLCSDR ;ALB/RJS - INITIALIZE VARIABLES AND OPEN DEVICE FOR RECEIVER ;07/20/99 14:00 [ 04/02/2003 8:37 AM ]
;;1.6;HEALTH LEVEL SEVEN;**1004**;APR 1, 2003
;;1.6;HEALTH LEVEL SEVEN;**2,14,49,57**;Oct 13, 1995
;THIS ROUTINE CONTAINS IHS MODIFICATIONS BY IHS/TUC/DLR 03/19/97
;AND IHS/OIRM/DSD/AEF 11/24/02
;
INIT ;
S HLZER=0
I '$D(HLDP)&($G(%)'="") S HLDP=% ;LAUNCHED FROM VMS
I '$D(HLDP) Q
D DT^DICRW
I HLDP'>0 S HLDP=$O(^HLCS(870,"B",HLDP,""))
I HLDP'>0 G EXIT
;HLDP IEN of LOGICAL LINK file #870
S HLDNODE=$G(^HLCS(870,HLDP,0))
S HLPARM=$G(^HLCS(870,HLDP,200))
;pointer to DEVICE file
S HLDEVPTR=$P(HLPARM,U)
G EXIT:HLDEVPTR'>0
S HLDEVICE=$P($G(^%ZIS(1,HLDEVPTR,0)),"^",1)
G EXIT:HLDEVICE=""
D FILE
INIT1 ;
G END:'HLZER
S HLZER=0
D OPEN G INIT1
FILE ;
D NOW^%DTC
L +^HLCS(870,HLDP,0):DTIME I '$T G FILE
;9=Time Started, 10=Time Stopped, 11=Task Number
;14=Shutdown LLP, 3=Shutdown LLP, 18=Gross Errors
I '$D(ZTSK) S ZTSK=""
S DIE="^HLCS(870,",DA=HLDP,DR="9////^S X=%;10////@;11////^S X=ZTSK;14////0;3////SH;18////@" D ^DIE K DIE,DA,DR
L -^HLCS(870,HLDP,0)
OPEN ;
;----- BEGIN IHS MODIFICATION
;THE 2 LINES BELOW ARE COMMENTED OUT AND REPLACED BY A NEW LINE
;NO $ETRAP AT IHS
;IHS/OIRM/DSD/AEF 11/24/02
;I $$NEWERR^%ZTER N $ETRAP,$ESTACK S $ETRAP="D ERROR^HLCSDR"
;E S X="ERROR^HLCSDR",@^%ZOSF("TRAP")
S X="ERROR^HLCSDR",@^%ZOSF("TRAP")
;----- END IHS MODIFICATION
OPEN1 I $P($G(^HLCS(870,HLDP,0)),U,15) G END
S HLST="OPEN" D STATUS(HLST,HLDP)
S IOP=HLDEVICE,%ZIS=0 D ^%ZIS
I POP S HLST="OPENFAIL" D STATUS(HLST,HLDP) H 5 G OPEN1
INIT2 ;
;Re-transmission attempts, Node, Hang Time, Start character,
;End character, LLP Version Number
S HLDAPP=$P(HLDNODE,U,1)
S HLRETPRM=$P(HLPARM,U,2),HLDBSIZE=$P(HLPARM,U,3),HLDREAD=$P(HLPARM,U,4),HLDWRITE=$P(HLPARM,U,5),HLDSTRT=$P(HLPARM,U,6),HLDEND=$P(HLPARM,U,7),HLDVER=$P(HLPARM,U,8)
;Defaults
I HLRETPRM="" S HLRETPRM=5
I HLDREAD="" S HLDREAD=10
I HLDWRITE="" S HLDWRITE=2
I HLDSTRT="" S HLDSTRT=11
I HLDEND="" S HLDEND=28
I HLDVER="" S HLDVER=21
I HLDBSIZE'>1 S HLDBSIZE=245
;Set up Device Params
;----- BEGIN IHS MODIFICATION
;IHS/TUC/DLR 03/19/97 - avoid wrap of long lines
;LINE BELOW IS COMMENTED OUT AND REPLACED BY NEW LINE
;S X=255 U IO X ^%ZOSF("EOFF"),^%ZOSF("RM"),^%ZOSF("TRMON")
S X=0 U IO X ^%ZOSF("EOFF"),^%ZOSF("RM"),^%ZOSF("TRMON")
;----- END IHS MODIFICATION
START ;
D START^HLCSDR1(HLDP,HLRETPRM,HLDREAD,HLDWRITE,HLDSTRT,HLDEND,HLDVER,HLDBSIZE)
END ;
I '$G(HLDP) G EXIT
D NOW^%DTC
L +^HLCS(870,HLDP,0):DTIME I '$T G END
;10=Time Stopped,9=Time Started,11=Task Number
S DIE="^HLCS(870,",DA=HLDP,DR="10////^S X=%;9////@;11////@" D ^DIE K DIE,DA,DR
L -^HLCS(870,HLDP,0)
EXIT ;
D ^%ZISC
K HLDNODE,HLDEVPTR,HLDEVICE,HLRETPRM,HLDAPP,X,HLDEND,HLDSTRT,HLDVER,HLDREAD,HLDWRITE,HLTRACE,ZTSK,HLDBSIZE,HLPARM
Q
STATUS(HLST,HLDP) ;Update field 4
;HLST=Current Status
;HLDP=IEN of Logical Link
S DIE="^HLCS(870,",DA=HLDP,DR="4///^S X=HLST" D ^DIE K DIE,DA,DR
Q
ERROR ;Trap disconnect & read errors
I $$EC^%ZOSV["DSCON"!($$EC^%ZOSV["data set hang-up") S HLST="DSCONECT" D STATUS(HLST,HLDP) H 3 S HLZER=1 I 1
E D ^%ZTER
S IO("C")=1 D ^%ZISC
G UNWIND^%ZTER
Q
HLCSDR ;ALB/RJS - INITIALIZE VARIABLES AND OPEN DEVICE FOR RECEIVER ;07/20/99 14:00 [ 04/02/2003 8:37 AM ]
+1 ;;1.6;HEALTH LEVEL SEVEN;**1004**;APR 1, 2003
+2 ;;1.6;HEALTH LEVEL SEVEN;**2,14,49,57**;Oct 13, 1995
+3 ;THIS ROUTINE CONTAINS IHS MODIFICATIONS BY IHS/TUC/DLR 03/19/97
+4 ;AND IHS/OIRM/DSD/AEF 11/24/02
+5 ;
INIT ;
+1 SET HLZER=0
+2 ;LAUNCHED FROM VMS
IF '$DATA(HLDP)&($GET(%)'="")
SET HLDP=%
+3 IF '$DATA(HLDP)
QUIT
+4 DO DT^DICRW
+5 IF HLDP'>0
SET HLDP=$ORDER(^HLCS(870,"B",HLDP,""))
+6 IF HLDP'>0
GOTO EXIT
+7 ;HLDP IEN of LOGICAL LINK file #870
+8 SET HLDNODE=$GET(^HLCS(870,HLDP,0))
+9 SET HLPARM=$GET(^HLCS(870,HLDP,200))
+10 ;pointer to DEVICE file
+11 SET HLDEVPTR=$PIECE(HLPARM,U)
+12 IF HLDEVPTR'>0
GOTO EXIT
+13 SET HLDEVICE=$PIECE($GET(^%ZIS(1,HLDEVPTR,0)),"^",1)
+14 IF HLDEVICE=""
GOTO EXIT
+15 DO FILE
INIT1 ;
+1 IF 'HLZER
GOTO END
+2 SET HLZER=0
+3 DO OPEN
GOTO INIT1
FILE ;
+1 DO NOW^%DTC
+2 LOCK +^HLCS(870,HLDP,0):DTIME
IF '$TEST
GOTO FILE
+3 ;9=Time Started, 10=Time Stopped, 11=Task Number
+4 ;14=Shutdown LLP, 3=Shutdown LLP, 18=Gross Errors
+5 IF '$DATA(ZTSK)
SET ZTSK=""
+6 SET DIE="^HLCS(870,"
SET DA=HLDP
SET DR="9////^S X=%;10////@;11////^S X=ZTSK;14////0;3////SH;18////@"
DO ^DIE
KILL DIE,DA,DR
+7 LOCK -^HLCS(870,HLDP,0)
OPEN ;
+1 ;----- BEGIN IHS MODIFICATION
+2 ;THE 2 LINES BELOW ARE COMMENTED OUT AND REPLACED BY A NEW LINE
+3 ;NO $ETRAP AT IHS
+4 ;IHS/OIRM/DSD/AEF 11/24/02
+5 ;I $$NEWERR^%ZTER N $ETRAP,$ESTACK S $ETRAP="D ERROR^HLCSDR"
+6 ;E S X="ERROR^HLCSDR",@^%ZOSF("TRAP")
+7 SET X="ERROR^HLCSDR"
SET @^%ZOSF("TRAP")
+8 ;----- END IHS MODIFICATION
OPEN1 IF $PIECE($GET(^HLCS(870,HLDP,0)),U,15)
GOTO END
+1 SET HLST="OPEN"
DO STATUS(HLST,HLDP)
+2 SET IOP=HLDEVICE
SET %ZIS=0
DO ^%ZIS
+3 IF POP
SET HLST="OPENFAIL"
DO STATUS(HLST,HLDP)
HANG 5
GOTO OPEN1
INIT2 ;
+1 ;Re-transmission attempts, Node, Hang Time, Start character,
+2 ;End character, LLP Version Number
+3 SET HLDAPP=$PIECE(HLDNODE,U,1)
+4 SET HLRETPRM=$PIECE(HLPARM,U,2)
SET HLDBSIZE=$PIECE(HLPARM,U,3)
SET HLDREAD=$PIECE(HLPARM,U,4)
SET HLDWRITE=$PIECE(HLPARM,U,5)
SET HLDSTRT=$PIECE(HLPARM,U,6)
SET HLDEND=$PIECE(HLPARM,U,7)
SET HLDVER=$PIECE(HLPARM,U,8)
+5 ;Defaults
+6 IF HLRETPRM=""
SET HLRETPRM=5
+7 IF HLDREAD=""
SET HLDREAD=10
+8 IF HLDWRITE=""
SET HLDWRITE=2
+9 IF HLDSTRT=""
SET HLDSTRT=11
+10 IF HLDEND=""
SET HLDEND=28
+11 IF HLDVER=""
SET HLDVER=21
+12 IF HLDBSIZE'>1
SET HLDBSIZE=245
+13 ;Set up Device Params
+14 ;----- BEGIN IHS MODIFICATION
+15 ;IHS/TUC/DLR 03/19/97 - avoid wrap of long lines
+16 ;LINE BELOW IS COMMENTED OUT AND REPLACED BY NEW LINE
+17 ;S X=255 U IO X ^%ZOSF("EOFF"),^%ZOSF("RM"),^%ZOSF("TRMON")
+18 SET X=0
USE IO
XECUTE ^%ZOSF("EOFF")
XECUTE ^%ZOSF("RM")
XECUTE ^%ZOSF("TRMON")
+19 ;----- END IHS MODIFICATION
START ;
+1 DO START^HLCSDR1(HLDP,HLRETPRM,HLDREAD,HLDWRITE,HLDSTRT,HLDEND,HLDVER,HLDBSIZE)
END ;
+1 IF '$GET(HLDP)
GOTO EXIT
+2 DO NOW^%DTC
+3 LOCK +^HLCS(870,HLDP,0):DTIME
IF '$TEST
GOTO END
+4 ;10=Time Stopped,9=Time Started,11=Task Number
+5 SET DIE="^HLCS(870,"
SET DA=HLDP
SET DR="10////^S X=%;9////@;11////@"
DO ^DIE
KILL DIE,DA,DR
+6 LOCK -^HLCS(870,HLDP,0)
EXIT ;
+1 DO ^%ZISC
+2 KILL HLDNODE,HLDEVPTR,HLDEVICE,HLRETPRM,HLDAPP,X,HLDEND,HLDSTRT,HLDVER,HLDREAD,HLDWRITE,HLTRACE,ZTSK,HLDBSIZE,HLPARM
+3 QUIT
STATUS(HLST,HLDP) ;Update field 4
+1 ;HLST=Current Status
+2 ;HLDP=IEN of Logical Link
+3 SET DIE="^HLCS(870,"
SET DA=HLDP
SET DR="4///^S X=HLST"
DO ^DIE
KILL DIE,DA,DR
+4 QUIT
ERROR ;Trap disconnect & read errors
+1 IF $$EC^%ZOSV["DSCON"!($$EC^%ZOSV["data set hang-up")
SET HLST="DSCONECT"
DO STATUS(HLST,HLDP)
HANG 3
SET HLZER=1
IF 1
+2 IF '$TEST
DO ^%ZTER
+3 SET IO("C")=1
DO ^%ZISC
+4 GOTO UNWIND^%ZTER
+5 QUIT
