HLCSREQ.m

HLCSREQ ;ALB/MFK - HL7 MESSAGE REQUEUER SCREEN # 3 ;02/16/2000  15:58 [ 04/02/2003   8:38 AM ]

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

 ;;1.6;HEALTH LEVEL SEVEN;**61**;Oct 13, 1995

EN ; -- main entry point

 D EN^VALM("HL MESSAGE REQUEUER - 1")

 Q

 ;

HDR ; -- header code

 N TMP

 S TMP="Known Logical Links"

 S VALMHDR(1)=$$SETSTR^VALM1(TMP,"",(40-($L(TMP)\2)),$L(TMP))

 Q

 ;

INIT ; -- init variables and list array

 ; -- build array of indices and queues

 N LLE,X,LINEENT,NAME,SIZE,HLPOINT,HLSENT,ENTRY,HLSTAT,X

 S LLE=0,X=0

 F  S LLE=$O(^HLCS(870,LLE)) Q:(LLE="")  D

 .Q:('$D(^HLCS(870,LLE,2,0)))

 .S LINEENT=""

 .S SIZE=$P(^HLCS(870,LLE,2,0),"^",4)

 .S:(SIZE="") SIZE=0

 .S HLPOINT="",HLSENT=0

 .F  S HLPOINT=$O(^HLCS(870,LLE,2,"B",HLPOINT)) Q:(HLPOINT="")  D

 ..S ENTRY=$O(^HLCS(870,LLE,2,"B",HLPOINT,""))

 ..Q:'ENTRY

 ..Q:'$D(^HLCS(870,LLE,2,ENTRY,0))

 ..S HLSTAT=$P($G(^HLCS(870,LLE,2,ENTRY,0)),"^",2)

 ..S HLSENT=HLSENT+($S(HLSTAT="P":0,1:1))

 .S NAME=$P(^HLCS(870,LLE,0),"^",1)

 .S X=X+1

 .S LINEENT=$$SETFLD^VALM1(X,LINEENT,"NUMBER")

 .S LINEENT=$$SETFLD^VALM1(NAME,LINEENT,"QUEUE")

 .S LINEENT=$$SETFLD^VALM1(SIZE,LINEENT,"SIZE")

 .S LINEENT=$$SETFLD^VALM1(HLSENT,LINEENT,"SENT")

 .S LINEENT=$$SETFLD^VALM1(SIZE-HLSENT,LINEENT,"PENDING")

 .;D SET^VALM10(X,LINEENT)

 .S ^TMP("HL",$J,X,0)=LINEENT

 .S ^TMP("HL",$J,"B",X,LLE)=""

 .S ^TMP("HL",$J,"IDX",X,X)=""

 I (X=0) S ^TMP("HL",$J,1,0)="** No logical links have been defined **"

 S VALMCNT=X

 Q

 ;

HELP ; -- help code

 S X="?" D DISP^XQORM1 W !!

 Q

 ;

EXIT ; -- exit code

 K ^TMP("HL",$J)

 Q

 ;

EXPND ; -- expand code

 N LOOP,MATCH,VALMY

 S LOOP=""

 D EN^VALM2(XQORNOD(0))

 ; -- find out what the user selected

 I ('$D(VALMY)) S VALMBCK="" Q

 F LOOP=$O(VALMY(LOOP)) Q:(LOOP="")  D

 .S MATCH=$O(^TMP("HL",$J,"B",LOOP,""))

 ; -- call entry to show individual messages

 D EN^HLCSRES(MATCH)

 ; -- re-index files in case entries were re-queued

 D INIT

 Q

 ;

HLCSREQ   ;ALB/MFK - HL7 MESSAGE REQUEUER SCREEN # 3 ;02/16/2000  15:58 [ 04/02/2003   8:38 AM ]

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

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

EN        ; -- main entry point

 +1        DO EN^VALM("HL MESSAGE REQUEUER - 1")

 +2        QUIT 

 +3       ;

HDR       ; -- header code

 +1        NEW TMP

 +2        SET TMP="Known Logical Links"

 +3        SET VALMHDR(1)=$$SETSTR^VALM1(TMP,"",(40-($LENGTH(TMP)\2)),$LENGTH(TMP))

 +4        QUIT 

 +5       ;

INIT      ; -- init variables and list array

 +1       ; -- build array of indices and queues

 +2        NEW LLE,X,LINEENT,NAME,SIZE,HLPOINT,HLSENT,ENTRY,HLSTAT,X

 +3        SET LLE=0

           SET X=0

 +4        FOR 

               SET LLE=$ORDER(^HLCS(870,LLE))

               IF (LLE="")

                   QUIT 

               Begin DoDot:1

 +5                IF ('$DATA(^HLCS(870,LLE,2,0)))

                       QUIT 

 +6                SET LINEENT=""

 +7                SET SIZE=$PIECE(^HLCS(870,LLE,2,0),"^",4)

 +8                IF (SIZE="")

                       SET SIZE=0

 +9                SET HLPOINT=""

                   SET HLSENT=0

 +10               FOR 

                       SET HLPOINT=$ORDER(^HLCS(870,LLE,2,"B",HLPOINT))

                       IF (HLPOINT="")

                           QUIT 

                       Begin DoDot:2

 +11                       SET ENTRY=$ORDER(^HLCS(870,LLE,2,"B",HLPOINT,""))

 +12                       IF 'ENTRY

                               QUIT 

 +13                       IF '$DATA(^HLCS(870,LLE,2,ENTRY,0))

                               QUIT 

 +14                       SET HLSTAT=$PIECE($GET(^HLCS(870,LLE,2,ENTRY,0)),"^",2)

 +15                       SET HLSENT=HLSENT+($SELECT(HLSTAT="P":0,1:1))

                       End DoDot:2

 +16               SET NAME=$PIECE(^HLCS(870,LLE,0),"^",1)

 +17               SET X=X+1

 +18               SET LINEENT=$$SETFLD^VALM1(X,LINEENT,"NUMBER")

 +19               SET LINEENT=$$SETFLD^VALM1(NAME,LINEENT,"QUEUE")

 +20               SET LINEENT=$$SETFLD^VALM1(SIZE,LINEENT,"SIZE")

 +21               SET LINEENT=$$SETFLD^VALM1(HLSENT,LINEENT,"SENT")

 +22               SET LINEENT=$$SETFLD^VALM1(SIZE-HLSENT,LINEENT,"PENDING")

 +23      ;D SET^VALM10(X,LINEENT)

 +24               SET ^TMP("HL",$JOB,X,0)=LINEENT

 +25               SET ^TMP("HL",$JOB,"B",X,LLE)=""

 +26               SET ^TMP("HL",$JOB,"IDX",X,X)=""

               End DoDot:1

 +27       IF (X=0)

               SET ^TMP("HL",$JOB,1,0)="** No logical links have been defined **"

 +28       SET VALMCNT=X

 +29       QUIT 

 +30      ;

HELP      ; -- help code

 +1        SET X="?"

           DO DISP^XQORM1

           WRITE !!

 +2        QUIT 

 +3       ;

EXIT      ; -- exit code

 +1        KILL ^TMP("HL",$JOB)

 +2        QUIT 

 +3       ;

EXPND     ; -- expand code

 +1        NEW LOOP,MATCH,VALMY

 +2        SET LOOP=""

 +3        DO EN^VALM2(XQORNOD(0))

 +4       ; -- find out what the user selected

 +5        IF ('$DATA(VALMY))

               SET VALMBCK=""

               QUIT 

 +6        FOR LOOP=$ORDER(VALMY(LOOP))

               IF (LOOP="")

                   QUIT 

               Begin DoDot:1

 +7                SET MATCH=$ORDER(^TMP("HL",$JOB,"B",LOOP,""))

               End DoDot:1

 +8       ; -- call entry to show individual messages

 +9        DO EN^HLCSRES(MATCH)

 +10      ; -- re-index files in case entries were re-queued

 +11       DO INIT

 +12       QUIT 

 +13      ;