HLCSREQ ;ALB/MFK - HL7 MESSAGE REQUEUER SCREEN # 3 ;02/16/2000 15:58
;;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
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HHLCSREQ 1912 printed Dec 13, 2024@01:56:55 Page 2
HLCSREQ ;ALB/MFK - HL7 MESSAGE REQUEUER SCREEN # 3 ;02/16/2000 15:58
+1 ;;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 ;
