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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRCRCVXM 3709 printed Apr 09, 2024@20:44:53 Page 2
RCRCVXM ;ALB/CMS - AR/RC ORIG BILL TRANSMISSION ; 16-JUN-00
V ;;4.5;Accounts Receivable;**63,159**;Mar 20, 1995
+1 ;;Per VHA Directive 10-93-142, this routine should not be modified.
+2 ;ORIGINAL BILL TRANSPORT
+3 ;
+4 QUIT
EN ;Entry from Protocol to Refer bills to RC
+1 NEW DIR,LN,PRCABN,RCA,RCCNT,RCCOM,RCDOM,RCMSG,RCSITE,RCY,X,Y
SET RCCNT=0
SET LN=4
+2 DO FULL^VALM1
+3 IF '$ORDER(^TMP("RCRCVL",$JOB,"SEL",0))
WRITE !!,"NOTHING TO REFER!",!,"No selected items from list."
GOTO ENQ
+4 WRITE !!
SET DIR("A",1)="Referring all bill(s) on highlighted Selection List "
+5 SET DIR("A",2)=" "
SET DIR("A",3)="This action will:"
+6 SET DIR("A",4)="Create a 'Refer to RC' or 'Re-establish Referral' AR Transaction,"
+7 SET DIR("A",5)="electronically transmit transferable bills to RC,"
+8 SET DIR("A",6)="list bills that did not pass the validation check and did not transmit,"
+9 SET DIR("A",7)="then mark the highlighted bills as referred."
+10 SET DIR("A",8)=" "
+11 SET DIR("A")="Okay to Continue: "
+12 DO ASK^RCRCACP
IF Y'=1
GOTO ENQ
+13 SET RCY=0
FOR
SET RCY=$ORDER(^TMP("RCRCVL",$JOB,"SEL",RCY))
if 'RCY
QUIT
Begin DoDot:1
+14 SET PRCABN=$PIECE($GET(^TMP("RCRCVLX",$JOB,RCY)),U,2)
WRITE "."
+15 IF 'PRCABN
QUIT
+16 KILL ^TMP("RCRCVL",$JOB,"XM",PRCABN)
+17 ; - Validate bill and save variables
+18 SET RCMSG=""
DO CHK^RCRCVCK(PRCABN,.RCMSG,1)
+19 IF RCMSG]""
SET RCA(PRCABN,RCY)=RCMSG
QUIT
+20 DO IBS^RCRCXM1
+21 QUIT
End DoDot:1
+22 ;
+23 ; - If nothing to send go write message on screen
+24 IF '$ORDER(^TMP("RCRCVL",$JOB,"XM",0))
GOTO ENW
+25 ;
+26 ; - create E-Mail and send off S RCCOM
+27 DO SEND
+28 ;
+29 ; - update AR Transaction,430 Referral Date and LM Screen
+30 DO ARUP
+31 ;
+32 ; - list bills that did not go
ENW IF $ORDER(RCA(0))
WRITE !!,"Did not Refer the following bills",!
Begin DoDot:1
+1 SET PRCABN=0
FOR
SET PRCABN=$ORDER(RCA(PRCABN))
if 'PRCABN
QUIT
Begin DoDot:2
+2 SET RCY=0
FOR
SET RCY=$ORDER(RCA(PRCABN,RCY))
if 'RCY
QUIT
Begin DoDot:3
+3 WRITE !,"Item ",RCY,". ",RCA(PRCABN,RCY)
+4 ;I $Y>(IOSL+3) D PAUSE^VALM1 W @IOF
End DoDot:3
End DoDot:2
End DoDot:1
+5 ;
ENQ KILL DIR
DO PAUSE^VALM1
SET VALMBCK="R"
+1 QUIT
+2 ;
SEND ;Send bills in mail message
+1 NEW DATA,II,LN,PRCABN,RCCNT,RCBDIV,RCI,RCSUB,RCWHO,RETRY
+2 NEW XNDUZ,XMSUB,XMTEXT,XMY,XMZ,X,Y
+3 SET (RCCNT,PRCABN)=0
FOR
SET PRCABN=$ORDER(^TMP("RCRCVL",$JOB,"XM",PRCABN))
if (RCCNT)!('PRCABN)
QUIT
Begin DoDot:1
+4 SET II=0
FOR
SET II=$ORDER(^TMP("RCRCVL",$JOB,"XM",PRCABN,II))
if (RCCNT)!('II)
QUIT
Begin DoDot:2
+5 SET RCCNT=RCCNT+1
End DoDot:2
End DoDot:1
+6 IF RCCNT=0
GOTO SENDQ
+7 SET (RCCNT,RETRY)=0
SET RCCOM=""
+8 SET RCSITE=$$SITE^RCMSITE
+9 IF $ORDER(RCDIV(0))
SET RCDOM=$PIECE($GET(RCDIV(+$PIECE($GET(RCDIV(0)),U,3))),U,6)
+10 IF $ORDER(^TMP("RCDOMAIN",$JOB,0))
SET RCDOM=$PIECE(^TMP("RCDOMAIN",$JOB,+$PIECE($GET(^TMP("RCDOMAIN",$JOB,0)),U,3)),U,6)
+11 IF $GET(RCDOM)=""
SET RCDOM=$$RCDOM^RCRCUTL
SNDA ;Come back here if didn't go to mail man
+1 SET (XMDUN,XMDUZ)=DUZ
+2 SET (RCSUB,XMSUB)="AR/RC - "_$GET(RCSITE,"UNK")_" ORIGINAL BILL TRANSMISSION"
+3 DO XMZ^XMA2
IF $GET(XMZ)<1
SET RETRY=RETRY+1
IF RETRY<100
GOTO SNDA
+4 IF $GET(XMZ)<1
GOTO SENDQ
+5 SET RCWHO=RCDOM
+6 SET XMY(RCWHO)=""
SET XMY(DUZ)=""
+7 SET ^XMB(3.9,XMZ,2,0)="^3.92^1^1^"_DT
+8 SET ^XMB(3.9,XMZ,2,1,0)="$$RC$OB$$"_RCSITE_"$S.RC RC SERV"
+9 SET PRCABN=0
SET LN=1
FOR
SET PRCABN=$ORDER(^TMP("RCRCVL",$JOB,"XM",PRCABN))
if 'PRCABN
QUIT
Begin DoDot:1
+10 IF $ORDER(^TMP("RCRCVL",$JOB,"XM",PRCABN,0))
SET RCCNT=RCCNT+1
+11 SET II=0
FOR
SET II=$ORDER(^TMP("RCRCVL",$JOB,"XM",PRCABN,II))
if 'II
QUIT
Begin DoDot:2
+12 SET RCI=0
FOR
SET RCI=$ORDER(^TMP("RCRCVL",$JOB,"XM",PRCABN,II,RCI))
if 'RCI
QUIT
Begin DoDot:3
+13 SET DATA=$GET(^TMP("RCRCVL",$JOB,"XM",PRCABN,II,RCI))
+14 IF DATA=""
QUIT
+15 SET LN=LN+1
+16 SET ^XMB(3.9,XMZ,2,LN,0)=DATA
End DoDot:3
End DoDot:2
End DoDot:1
+17 ;
+18 SET ^XMB(3.9,XMZ,2,LN+1,0)="$END$"_LN_"$"_RCCNT_"$"
+19 DO ENT1^XMD
+20 WRITE !!,"Message #",XMZ," Transmitted ",$GET(RCCNT,0)," bill(s)."
+21 SET RCCOM="Message contains "_+$GET(RCCNT)_" bill(s)."
+22 DO ENT^RCRCXMS(XMZ,RCSUB,RCWHO,.RCCOM)
SENDQ QUIT
+1 ;
ARUP ;Update AR with information
+1 NEW PRCABN,RCY
+2 SET PRCABN=0
FOR
SET PRCABN=$ORDER(^TMP("RCRCVL",$JOB,"XM",PRCABN))
if 'PRCABN
QUIT
Begin DoDot:1
+3 DO REF^RCRCRT
+4 ; - Reset field in List Template
+5 SET RCY=^TMP("RCRCVL",$JOB,"XM",PRCABN,0)
+6 DO FLDTEXT^VALM10(RCY,"REFER","r")
+7 QUIT
End DoDot:1
ARUPQ QUIT
+1 ;
+2 ;RCRCVXM
