97 lines
3.5 KiB
Mathematica
97 lines
3.5 KiB
Mathematica
RCRCVXM ;ALB/CMS - AR/RC ORIG BILL TRANSMISSION ; 16-JUN-00
|
|
V ;;4.5;Accounts Receivable;**63,159**;Mar 20, 1995
|
|
;;Per VHA Directive 10-93-142, this routine should not be modified.
|
|
;ORIGINAL BILL TRANSPORT
|
|
;
|
|
Q
|
|
EN ;Entry from Protocol to Refer bills to RC
|
|
N DIR,LN,PRCABN,RCA,RCCNT,RCCOM,RCDOM,RCMSG,RCSITE,RCY,X,Y S RCCNT=0,LN=4
|
|
D FULL^VALM1
|
|
I '$O(^TMP("RCRCVL",$J,"SEL",0)) W !!,"NOTHING TO REFER!",!,"No selected items from list." G ENQ
|
|
W !! S DIR("A",1)="Referring all bill(s) on highlighted Selection List "
|
|
S DIR("A",2)=" ",DIR("A",3)="This action will:"
|
|
S DIR("A",4)="Create a 'Refer to RC' or 'Re-establish Referral' AR Transaction,"
|
|
S DIR("A",5)="electronically transmit transferable bills to RC,"
|
|
S DIR("A",6)="list bills that did not pass the validation check and did not transmit,"
|
|
S DIR("A",7)="then mark the highlighted bills as referred."
|
|
S DIR("A",8)=" "
|
|
S DIR("A")="Okay to Continue: "
|
|
D ASK^RCRCACP I Y'=1 G ENQ
|
|
S RCY=0 F S RCY=$O(^TMP("RCRCVL",$J,"SEL",RCY)) Q:'RCY D
|
|
.S PRCABN=$P($G(^TMP("RCRCVLX",$J,RCY)),U,2) W "."
|
|
.I 'PRCABN Q
|
|
.K ^TMP("RCRCVL",$J,"XM",PRCABN)
|
|
.; - Validate bill and save variables
|
|
.S RCMSG="" D CHK^RCRCVCK(PRCABN,.RCMSG,1)
|
|
.I RCMSG]"" S RCA(PRCABN,RCY)=RCMSG Q
|
|
.D IBS^RCRCXM1
|
|
.Q
|
|
;
|
|
; - If nothing to send go write message on screen
|
|
I '$O(^TMP("RCRCVL",$J,"XM",0)) G ENW
|
|
;
|
|
; - create E-Mail and send off S RCCOM
|
|
D SEND
|
|
;
|
|
; - update AR Transaction,430 Referral Date and LM Screen
|
|
D ARUP
|
|
;
|
|
; - list bills that did not go
|
|
ENW I $O(RCA(0)) W !!,"Did not Refer the following bills",! D
|
|
.S PRCABN=0 F S PRCABN=$O(RCA(PRCABN)) Q:'PRCABN D
|
|
..S RCY=0 F S RCY=$O(RCA(PRCABN,RCY)) Q:'RCY D
|
|
...W !,"Item ",RCY,". ",RCA(PRCABN,RCY)
|
|
...;I $Y>(IOSL+3) D PAUSE^VALM1 W @IOF
|
|
;
|
|
ENQ K DIR D PAUSE^VALM1 S VALMBCK="R"
|
|
Q
|
|
;
|
|
SEND ;Send bills in mail message
|
|
N DATA,II,LN,PRCABN,RCCNT,RCBDIV,RCI,RCSUB,RCWHO,RETRY
|
|
N XNDUZ,XMSUB,XMTEXT,XMY,XMZ,X,Y
|
|
S (RCCNT,PRCABN)=0 F S PRCABN=$O(^TMP("RCRCVL",$J,"XM",PRCABN)) Q:(RCCNT)!('PRCABN) D
|
|
.S II=0 F S II=$O(^TMP("RCRCVL",$J,"XM",PRCABN,II)) Q:(RCCNT)!('II) D
|
|
..S RCCNT=RCCNT+1
|
|
I RCCNT=0 G SENDQ
|
|
S (RCCNT,RETRY)=0,RCCOM=""
|
|
S RCSITE=$$SITE^RCMSITE
|
|
I $O(RCDIV(0)) S RCDOM=$P($G(RCDIV(+$P($G(RCDIV(0)),U,3))),U,6)
|
|
I $O(^TMP("RCDOMAIN",$J,0)) S RCDOM=$P(^TMP("RCDOMAIN",$J,+$P($G(^TMP("RCDOMAIN",$J,0)),U,3)),U,6)
|
|
I $G(RCDOM)="" S RCDOM=$$RCDOM^RCRCUTL
|
|
SNDA ;Come back here if didn't go to mail man
|
|
S (XMDUN,XMDUZ)=DUZ
|
|
S (RCSUB,XMSUB)="AR/RC - "_$G(RCSITE,"UNK")_" ORIGINAL BILL TRANSMISSION"
|
|
D XMZ^XMA2 I $G(XMZ)<1 S RETRY=RETRY+1 I RETRY<100 G SNDA
|
|
I $G(XMZ)<1 G SENDQ
|
|
S RCWHO=RCDOM
|
|
S XMY(RCWHO)="",XMY(DUZ)=""
|
|
S ^XMB(3.9,XMZ,2,0)="^3.92^1^1^"_DT
|
|
S ^XMB(3.9,XMZ,2,1,0)="$$RC$OB$$"_RCSITE_"$S.RC RC SERV"
|
|
S PRCABN=0,LN=1 F S PRCABN=$O(^TMP("RCRCVL",$J,"XM",PRCABN)) Q:'PRCABN D
|
|
.I $O(^TMP("RCRCVL",$J,"XM",PRCABN,0)) S RCCNT=RCCNT+1
|
|
.S II=0 F S II=$O(^TMP("RCRCVL",$J,"XM",PRCABN,II)) Q:'II D
|
|
..S RCI=0 F S RCI=$O(^TMP("RCRCVL",$J,"XM",PRCABN,II,RCI)) Q:'RCI D
|
|
...S DATA=$G(^TMP("RCRCVL",$J,"XM",PRCABN,II,RCI))
|
|
...I DATA="" Q
|
|
...S LN=LN+1
|
|
...S ^XMB(3.9,XMZ,2,LN,0)=DATA
|
|
;
|
|
S ^XMB(3.9,XMZ,2,LN+1,0)="$END$"_LN_"$"_RCCNT_"$"
|
|
D ENT1^XMD
|
|
W !!,"Message #",XMZ," Transmitted ",$G(RCCNT,0)," bill(s)."
|
|
S RCCOM="Message contains "_+$G(RCCNT)_" bill(s)."
|
|
D ENT^RCRCXMS(XMZ,RCSUB,RCWHO,.RCCOM)
|
|
SENDQ Q
|
|
;
|
|
ARUP ;Update AR with information
|
|
N PRCABN,RCY
|
|
S PRCABN=0 F S PRCABN=$O(^TMP("RCRCVL",$J,"XM",PRCABN)) Q:'PRCABN D
|
|
.D REF^RCRCRT
|
|
.; - Reset field in List Template
|
|
.S RCY=^TMP("RCRCVL",$J,"XM",PRCABN,0)
|
|
.D FLDTEXT^VALM10(RCY,"REFER","r")
|
|
.Q
|
|
ARUPQ Q
|
|
;
|
|
;RCRCVXM
|