| [613] | 1 | RCRCEL ;WASH@ALTOONA/LDB/CMS - RCRC TRANSMISISON LOG ; 27-MAR-1998
|
|---|
| 2 | V ;;4.5;Accounts Receivable;**63**;Mar 20, 1995
|
|---|
| 3 | ;;Per VHA Directive 10-93-142, this routine should not be modified
|
|---|
| 4 | EN ; -- main entry point for RCRC TRANSMISSION LOG
|
|---|
| 5 | W !!,?3,"Building Transmission Log list ......."
|
|---|
| 6 | D EN^VALM("RCRC TRANSMISSION LOG")
|
|---|
| 7 | Q
|
|---|
| 8 | ;
|
|---|
| 9 | HDR ; -- header code
|
|---|
| 10 | S VALMHDR(1)=" Regional Counsel"
|
|---|
| 11 | S VALMHDR(2)=" Transmission Message Handler"
|
|---|
| 12 | I +$G(VALMCNT)=0 S VALMSG="NO MESSAGES FOUND"
|
|---|
| 13 | Q
|
|---|
| 14 | ;
|
|---|
| 15 | INIT ; -- init variables and list array
|
|---|
| 16 | N RCBN0,RCBN2,RCCNT,RCDATE,RCCOM,RCNT,RCX,RCY,X,Y
|
|---|
| 17 | K ^TMP("RCRCE",$J),^TMP("RCRCEX",$J)
|
|---|
| 18 | ;
|
|---|
| 19 | REQ ;Reverse order of entries entry for Resequenceing
|
|---|
| 20 | S RCY=0 F S RCY=$O(^RCT(349.3,RCY)) Q:'RCY D
|
|---|
| 21 | .S ^TMP("RCRCE",$J,"D",9999999.999999-+$G(^RCT(349.3,RCY,2)),99999999999-RCY)=RCY
|
|---|
| 22 | I '$O(^TMP("RCRCE",$J,"D",0)) S VALMCNT=0 G INITQ
|
|---|
| 23 | ;
|
|---|
| 24 | ;Set "B" to new order
|
|---|
| 25 | S (RCDATE,RCCNT)=0 F S RCDATE=$O(^TMP("RCRCE",$J,"D",RCDATE)) Q:'RCDATE D
|
|---|
| 26 | .S RCX=0 F S RCX=$O(^TMP("RCRCE",$J,"D",RCDATE,RCX)) Q:'RCX D
|
|---|
| 27 | ..S RCCNT=RCCNT+1
|
|---|
| 28 | ..S ^TMP("RCRCE",$J,"B",RCCNT)=^TMP("RCRCE",$J,"D",RCDATE,RCX)
|
|---|
| 29 | K ^TMP("RCRCE",$J,"D")
|
|---|
| 30 | ;
|
|---|
| 31 | ;Set data in TMP
|
|---|
| 32 | S (RCCNT,VALMCNT)=0 F S RCCNT=$O(^TMP("RCRCE",$J,"B",RCCNT)) Q:'RCCNT D
|
|---|
| 33 | .S RCY=^TMP("RCRCE",$J,"B",RCCNT),VALMCNT=VALMCNT+1
|
|---|
| 34 | .S RCBN0=$G(^RCT(349.3,+RCY,0)),RCBN2=$G(^RCT(349.3,+RCY,2))
|
|---|
| 35 | .S (RCNT,RCX)=0 K RCCOM F S RCX=$O(^RCT(349.3,+RCY,3,RCX)) Q:'RCX D
|
|---|
| 36 | ..I $G(^RCT(349.3,+RCY,3,RCX,0))]"" S RCNT=RCNT+1,RCCOM(RCNT)=$E(^(0),1,80)
|
|---|
| 37 | .S X="",X=$$SETFLD^VALM1(RCCNT,X,"NUMBER")
|
|---|
| 38 | .S RCX=$S($P(RCBN0,U,2)]"":$E($P(RCBN0,U,2),1,42),1:"No Subject"),X=$$SETFLD^VALM1(RCX,X,"SUBJECT")
|
|---|
| 39 | .S X=$$SETFLD^VALM1(+RCBN0,X,"MM#")
|
|---|
| 40 | .S RCX=$$FMTE^XLFDT(+RCBN2,"5ZD"),X=$$SETFLD^VALM1(RCX,X,"DATE")
|
|---|
| 41 | .S RCX=$$FMTE^XLFDT(+$G(^RCT(349.3,+RCY,4)),"5ZD"),X=$$SETFLD^VALM1(RCX,X,"PDATE")
|
|---|
| 42 | .S ^TMP("RCRCE",$J,VALMCNT,0)=X
|
|---|
| 43 | .S ^TMP("RCRCE",$J,"IDX",VALMCNT,RCCNT)=""
|
|---|
| 44 | .S ^TMP("RCRCEX",$J,RCCNT)=VALMCNT_U_RCY
|
|---|
| 45 | .S VALMCNT=VALMCNT+1
|
|---|
| 46 | .S ^TMP("RCRCE",$J,VALMCNT,0)=" Sender: "_$P($G(RCBN0),U,3)_" Recipient: "_$P($G(RCBN0),U,4)
|
|---|
| 47 | .S ^TMP("RCRCE",$J,"IDX",VALMCNT,RCCNT)=""
|
|---|
| 48 | .S RCX=0 F S RCX=$O(RCCOM(RCX)) Q:'RCX D
|
|---|
| 49 | ..S VALMCNT=VALMCNT+1
|
|---|
| 50 | ..S ^TMP("RCRCE",$J,VALMCNT,0)=$S(RCX=1:" Comment: ",1:" ")_RCCOM(RCX)
|
|---|
| 51 | ..S ^TMP("RCRCE",$J,"IDX",VALMCNT,RCCNT)=""
|
|---|
| 52 | .D FLDCTRL^VALM10(VALMCNT)
|
|---|
| 53 | INITQ Q
|
|---|
| 54 | ;
|
|---|
| 55 | HELP ; -- help code
|
|---|
| 56 | S X="?" D DISP^XQORM1 W !!
|
|---|
| 57 | Q
|
|---|
| 58 | ;
|
|---|
| 59 | EXIT ; -- exit code
|
|---|
| 60 | K ^TMP("RCRCE",$J),^TMP("RCRCEX",$J)
|
|---|
| 61 | K RCOUT,VALMBCK,VALMSG,VALMCNT
|
|---|
| 62 | D CLEAN^VALM10,CLEAR^VALM1
|
|---|
| 63 | Q
|
|---|
| 64 | ;
|
|---|
| 65 | EXPND ; -- expand code
|
|---|
| 66 | Q
|
|---|
| 67 | ;RCRCEL
|
|---|
