HLCSMM1.m

HLCSMM1 ;ISC-SF/JC - HL7 PROTOCOL FOR MAILMAN  ;07/07/99  17:43 [ 04/02/2003   8:38 AM ]

 ;;1.6;HEALTH LEVEL SEVEN;**1004**;APR 1, 2003

 ;;1.6;HEALTH LEVEL SEVEN;**35,49**;Oct 13, 1995

INIT ;

 N HLNOW,HLDOUT0,HLDOUT1

 Q:'$D(HLDP)

 D NOW^%DTC S HLNOW=%

UPDT ;Update link info

 F  L +^HLCS(870,HLDP,0):DTIME Q:$T  H 1

 S ZTSK=$G(ZTSK)

 I ZTSK="" S HLTRACE=""

 S DIE="^HLCS(870,",DA=HLDP

 S DR="9////^S X=HLNOW;10////@;14////0;3////MM;18////@"

 I ZTSK S DR=DR_";11////^S X=ZTSK"

 D ^DIE K DIE,DA,DR

 L -^HLCS(870,HLDP,0)

LOOP ;Begin send loop

 S STOP=0

 F  H 1 D START Q:STOP

START ;

 S HLNXST="IDLE"

 D TRACE^HLCSDR2,STATUS(HLNXST)

 S HLDOUT0=$$DEQUEUE^HLCSQUE(HLDP,"OUT")

 S HLDOUT1=$P(HLDOUT0,U,2),HLDOUT0=+HLDOUT0

 I HLDOUT0'<0 D

 .S HLNXST="WRITING" D TRACE^HLCSDR2,STATUS(HLNXST)

 .D EN^HLCSMM(HLDOUT0,HLDOUT1)

 I $D(HLTRACE) U IO(0) W !,"Type 'Q' to quit: " R X:1 I $G(X)'=""&("Qq"[X) D

 .F  L +^HLCS(870,HLDP,0):DTIME Q:$T  H 1

 .S $P(^HLCS(870,HLDP,0),U,15)=1

 .L -^HLCS(870,HLDP,0)

 D STOP

 Q

STATUS(HLNXST) ;Status update

 F  L +^HLCS(870,HLDP,0):DTIME Q:$T  H 1

 I $G(HLNXST)]"",$P(^HLCS(870,HLDP,0),U,5)=HLNXST L -^HLCS(870,HLDP,0) Q

 S $P(^HLCS(870,HLDP,0),U,5)=HLNXST

 L -^HLCS(870,HLDP,0)

 D STOP

 Q

STOP ;Check for Shutdown request

 D NOW^%DTC

 F  L +^HLCS(870,HLDP,0):DTIME Q:$T  H 1

 I $P(^HLCS(870,HLDP,0),U,15)'=1 L -^HLCS(870,HLDP,0) Q

 S STOP=1,HLNXST="SHUTDOWN"

 S DIE="^HLCS(870,",DA=HLDP

 S DR="4///^S X=HLNXST;10////^S X=%;9////@;11////@"

 D ^DIE K DIE,DA,DR

 L -^HLCS(870,HLDP,0)

 Q

HLCSMM1   ;ISC-SF/JC - HL7 PROTOCOL FOR MAILMAN  ;07/07/99  17:43 [ 04/02/2003   8:38 AM ]

 +1       ;;1.6;HEALTH LEVEL SEVEN;**1004**;APR 1, 2003

 +2       ;;1.6;HEALTH LEVEL SEVEN;**35,49**;Oct 13, 1995

INIT      ;

 +1        NEW HLNOW,HLDOUT0,HLDOUT1

 +2        IF '$DATA(HLDP)

               QUIT 

 +3        DO NOW^%DTC

           SET HLNOW=%

UPDT      ;Update link info

 +1        FOR 

               LOCK +^HLCS(870,HLDP,0):DTIME

               IF $TEST

                   QUIT 

               HANG 1

 +2        SET ZTSK=$GET(ZTSK)

 +3        IF ZTSK=""

               SET HLTRACE=""

 +4        SET DIE="^HLCS(870,"

           SET DA=HLDP

 +5        SET DR="9////^S X=HLNOW;10////@;14////0;3////MM;18////@"

 +6        IF ZTSK

               SET DR=DR_";11////^S X=ZTSK"

 +7        DO ^DIE

           KILL DIE,DA,DR

 +8        LOCK -^HLCS(870,HLDP,0)

LOOP      ;Begin send loop

 +1        SET STOP=0

 +2        FOR 

               HANG 1

               DO START

               IF STOP

                   QUIT 

START     ;

 +1        SET HLNXST="IDLE"

 +2        DO TRACE^HLCSDR2

           DO STATUS(HLNXST)

 +3        SET HLDOUT0=$$DEQUEUE^HLCSQUE(HLDP,"OUT")

 +4        SET HLDOUT1=$PIECE(HLDOUT0,U,2)

           SET HLDOUT0=+HLDOUT0

 +5        IF HLDOUT0'<0

               Begin DoDot:1

 +6                SET HLNXST="WRITING"

                   DO TRACE^HLCSDR2

                   DO STATUS(HLNXST)

 +7                DO EN^HLCSMM(HLDOUT0,HLDOUT1)

               End DoDot:1

 +8        IF $DATA(HLTRACE)

               USE IO(0)

               WRITE !,"Type 'Q' to quit: "

               READ X:1

               IF $GET(X)'=""&("Qq"[X)

                   Begin DoDot:1

 +9                    FOR 

                           LOCK +^HLCS(870,HLDP,0):DTIME

                           IF $TEST

                               QUIT 

                           HANG 1

 +10                   SET $PIECE(^HLCS(870,HLDP,0),U,15)=1

 +11                   LOCK -^HLCS(870,HLDP,0)

                   End DoDot:1

 +12       DO STOP

 +13       QUIT 

STATUS(HLNXST) ;Status update

 +1        FOR 

               LOCK +^HLCS(870,HLDP,0):DTIME

               IF $TEST

                   QUIT 

               HANG 1

 +2        IF $GET(HLNXST)]""

               IF $PIECE(^HLCS(870,HLDP,0),U,5)=HLNXST

                   LOCK -^HLCS(870,HLDP,0)

                   QUIT 

 +3        SET $PIECE(^HLCS(870,HLDP,0),U,5)=HLNXST

 +4        LOCK -^HLCS(870,HLDP,0)

 +5        DO STOP

 +6        QUIT 

STOP      ;Check for Shutdown request

 +1        DO NOW^%DTC

 +2        FOR 

               LOCK +^HLCS(870,HLDP,0):DTIME

               IF $TEST

                   QUIT 

               HANG 1

 +3        IF $PIECE(^HLCS(870,HLDP,0),U,15)'=1

               LOCK -^HLCS(870,HLDP,0)

               QUIT 

 +4        SET STOP=1

           SET HLNXST="SHUTDOWN"

 +5        SET DIE="^HLCS(870,"

           SET DA=HLDP

 +6        SET DR="4///^S X=HLNXST;10////^S X=%;9////@;11////@"

 +7        DO ^DIE

           KILL DIE,DA,DR

 +8        LOCK -^HLCS(870,HLDP,0)

 +9        QUIT