RCRCEL ;WASH@ALTOONA/LDB/CMS - RCRC TRANSMISISON LOG ; 27-MAR-1998
V ;;4.5;Accounts Receivable;**63**;Mar 20, 1995
;;Per VHA Directive 10-93-142, this routine should not be modified
EN ; -- main entry point for RCRC TRANSMISSION LOG
W !!,?3,"Building Transmission Log list ......."
D EN^VALM("RCRC TRANSMISSION LOG")
Q
;
HDR ; -- header code
S VALMHDR(1)=" Regional Counsel"
S VALMHDR(2)=" Transmission Message Handler"
I +$G(VALMCNT)=0 S VALMSG="NO MESSAGES FOUND"
Q
;
INIT ; -- init variables and list array
N RCBN0,RCBN2,RCCNT,RCDATE,RCCOM,RCNT,RCX,RCY,X,Y
K ^TMP("RCRCE",$J),^TMP("RCRCEX",$J)
;
REQ ;Reverse order of entries entry for Resequenceing
S RCY=0 F S RCY=$O(^RCT(349.3,RCY)) Q:'RCY D
.S ^TMP("RCRCE",$J,"D",9999999.999999-+$G(^RCT(349.3,RCY,2)),99999999999-RCY)=RCY
I '$O(^TMP("RCRCE",$J,"D",0)) S VALMCNT=0 G INITQ
;
;Set "B" to new order
S (RCDATE,RCCNT)=0 F S RCDATE=$O(^TMP("RCRCE",$J,"D",RCDATE)) Q:'RCDATE D
.S RCX=0 F S RCX=$O(^TMP("RCRCE",$J,"D",RCDATE,RCX)) Q:'RCX D
..S RCCNT=RCCNT+1
..S ^TMP("RCRCE",$J,"B",RCCNT)=^TMP("RCRCE",$J,"D",RCDATE,RCX)
K ^TMP("RCRCE",$J,"D")
;
;Set data in TMP
S (RCCNT,VALMCNT)=0 F S RCCNT=$O(^TMP("RCRCE",$J,"B",RCCNT)) Q:'RCCNT D
.S RCY=^TMP("RCRCE",$J,"B",RCCNT),VALMCNT=VALMCNT+1
.S RCBN0=$G(^RCT(349.3,+RCY,0)),RCBN2=$G(^RCT(349.3,+RCY,2))
.S (RCNT,RCX)=0 K RCCOM F S RCX=$O(^RCT(349.3,+RCY,3,RCX)) Q:'RCX D
..I $G(^RCT(349.3,+RCY,3,RCX,0))]"" S RCNT=RCNT+1,RCCOM(RCNT)=$E(^(0),1,80)
.S X="",X=$$SETFLD^VALM1(RCCNT,X,"NUMBER")
.S RCX=$S($P(RCBN0,U,2)]"":$E($P(RCBN0,U,2),1,42),1:"No Subject"),X=$$SETFLD^VALM1(RCX,X,"SUBJECT")
.S X=$$SETFLD^VALM1(+RCBN0,X,"MM#")
.S RCX=$$FMTE^XLFDT(+RCBN2,"5ZD"),X=$$SETFLD^VALM1(RCX,X,"DATE")
.S RCX=$$FMTE^XLFDT(+$G(^RCT(349.3,+RCY,4)),"5ZD"),X=$$SETFLD^VALM1(RCX,X,"PDATE")
.S ^TMP("RCRCE",$J,VALMCNT,0)=X
.S ^TMP("RCRCE",$J,"IDX",VALMCNT,RCCNT)=""
.S ^TMP("RCRCEX",$J,RCCNT)=VALMCNT_U_RCY
.S VALMCNT=VALMCNT+1
.S ^TMP("RCRCE",$J,VALMCNT,0)=" Sender: "_$P($G(RCBN0),U,3)_" Recipient: "_$P($G(RCBN0),U,4)
.S ^TMP("RCRCE",$J,"IDX",VALMCNT,RCCNT)=""
.S RCX=0 F S RCX=$O(RCCOM(RCX)) Q:'RCX D
..S VALMCNT=VALMCNT+1
..S ^TMP("RCRCE",$J,VALMCNT,0)=$S(RCX=1:" Comment: ",1:" ")_RCCOM(RCX)
..S ^TMP("RCRCE",$J,"IDX",VALMCNT,RCCNT)=""
.D FLDCTRL^VALM10(VALMCNT)
INITQ Q
;
HELP ; -- help code
S X="?" D DISP^XQORM1 W !!
Q
;
EXIT ; -- exit code
K ^TMP("RCRCE",$J),^TMP("RCRCEX",$J)
K RCOUT,VALMBCK,VALMSG,VALMCNT
D CLEAN^VALM10,CLEAR^VALM1
Q
;
EXPND ; -- expand code
Q
;RCRCEL
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRCRCEL 2655 printed Apr 09, 2024@20:51:53 Page 2
RCRCEL ;WASH@ALTOONA/LDB/CMS - RCRC TRANSMISISON LOG ; 27-MAR-1998
V ;;4.5;Accounts Receivable;**63**;Mar 20, 1995
+1 ;;Per VHA Directive 10-93-142, this routine should not be modified
EN ; -- main entry point for RCRC TRANSMISSION LOG
+1 WRITE !!,?3,"Building Transmission Log list ......."
+2 DO EN^VALM("RCRC TRANSMISSION LOG")
+3 QUIT
+4 ;
HDR ; -- header code
+1 SET VALMHDR(1)=" Regional Counsel"
+2 SET VALMHDR(2)=" Transmission Message Handler"
+3 IF +$GET(VALMCNT)=0
SET VALMSG="NO MESSAGES FOUND"
+4 QUIT
+5 ;
INIT ; -- init variables and list array
+1 NEW RCBN0,RCBN2,RCCNT,RCDATE,RCCOM,RCNT,RCX,RCY,X,Y
+2 KILL ^TMP("RCRCE",$JOB),^TMP("RCRCEX",$JOB)
+3 ;
REQ ;Reverse order of entries entry for Resequenceing
+1 SET RCY=0
FOR
SET RCY=$ORDER(^RCT(349.3,RCY))
if 'RCY
QUIT
Begin DoDot:1
+2 SET ^TMP("RCRCE",$JOB,"D",9999999.999999-+$GET(^RCT(349.3,RCY,2)),99999999999-RCY)=RCY
End DoDot:1
+3 IF '$ORDER(^TMP("RCRCE",$JOB,"D",0))
SET VALMCNT=0
GOTO INITQ
+4 ;
+5 ;Set "B" to new order
+6 SET (RCDATE,RCCNT)=0
FOR
SET RCDATE=$ORDER(^TMP("RCRCE",$JOB,"D",RCDATE))
if 'RCDATE
QUIT
Begin DoDot:1
+7 SET RCX=0
FOR
SET RCX=$ORDER(^TMP("RCRCE",$JOB,"D",RCDATE,RCX))
if 'RCX
QUIT
Begin DoDot:2
+8 SET RCCNT=RCCNT+1
+9 SET ^TMP("RCRCE",$JOB,"B",RCCNT)=^TMP("RCRCE",$JOB,"D",RCDATE,RCX)
End DoDot:2
End DoDot:1
+10 KILL ^TMP("RCRCE",$JOB,"D")
+11 ;
+12 ;Set data in TMP
+13 SET (RCCNT,VALMCNT)=0
FOR
SET RCCNT=$ORDER(^TMP("RCRCE",$JOB,"B",RCCNT))
if 'RCCNT
QUIT
Begin DoDot:1
+14 SET RCY=^TMP("RCRCE",$JOB,"B",RCCNT)
SET VALMCNT=VALMCNT+1
+15 SET RCBN0=$GET(^RCT(349.3,+RCY,0))
SET RCBN2=$GET(^RCT(349.3,+RCY,2))
+16 SET (RCNT,RCX)=0
KILL RCCOM
FOR
SET RCX=$ORDER(^RCT(349.3,+RCY,3,RCX))
if 'RCX
QUIT
Begin DoDot:2
+17 IF $GET(^RCT(349.3,+RCY,3,RCX,0))]""
SET RCNT=RCNT+1
SET RCCOM(RCNT)=$EXTRACT(^(0),1,80)
End DoDot:2
+18 SET X=""
SET X=$$SETFLD^VALM1(RCCNT,X,"NUMBER")
+19 SET RCX=$SELECT($PIECE(RCBN0,U,2)]"":$EXTRACT($PIECE(RCBN0,U,2),1,42),1:"No Subject")
SET X=$$SETFLD^VALM1(RCX,X,"SUBJECT")
+20 SET X=$$SETFLD^VALM1(+RCBN0,X,"MM#")
+21 SET RCX=$$FMTE^XLFDT(+RCBN2,"5ZD")
SET X=$$SETFLD^VALM1(RCX,X,"DATE")
+22 SET RCX=$$FMTE^XLFDT(+$GET(^RCT(349.3,+RCY,4)),"5ZD")
SET X=$$SETFLD^VALM1(RCX,X,"PDATE")
+23 SET ^TMP("RCRCE",$JOB,VALMCNT,0)=X
+24 SET ^TMP("RCRCE",$JOB,"IDX",VALMCNT,RCCNT)=""
+25 SET ^TMP("RCRCEX",$JOB,RCCNT)=VALMCNT_U_RCY
+26 SET VALMCNT=VALMCNT+1
+27 SET ^TMP("RCRCE",$JOB,VALMCNT,0)=" Sender: "_$PIECE($GET(RCBN0),U,3)_" Recipient: "_$PIECE($GET(RCBN0),U,4)
+28 SET ^TMP("RCRCE",$JOB,"IDX",VALMCNT,RCCNT)=""
+29 SET RCX=0
FOR
SET RCX=$ORDER(RCCOM(RCX))
if 'RCX
QUIT
Begin DoDot:2
+30 SET VALMCNT=VALMCNT+1
+31 SET ^TMP("RCRCE",$JOB,VALMCNT,0)=$SELECT(RCX=1:" Comment: ",1:" ")_RCCOM(RCX)
+32 SET ^TMP("RCRCE",$JOB,"IDX",VALMCNT,RCCNT)=""
End DoDot:2
+33 DO FLDCTRL^VALM10(VALMCNT)
End DoDot:1
INITQ QUIT
+1 ;
HELP ; -- help code
+1 SET X="?"
DO DISP^XQORM1
WRITE !!
+2 QUIT
+3 ;
EXIT ; -- exit code
+1 KILL ^TMP("RCRCE",$JOB),^TMP("RCRCEX",$JOB)
+2 KILL RCOUT,VALMBCK,VALMSG,VALMCNT
+3 DO CLEAN^VALM10
DO CLEAR^VALM1
+4 QUIT
+5 ;
EXPND ; -- expand code
+1 QUIT
+2 ;RCRCEL
