- 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 Feb 18, 2025@23:14:01 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