RCXVDC7 ;TJK/ALBANY OI @ALTOONA, PA-AR Data Extraction Data Creation ;02-JUL-03
;;4.5;Accounts Receivable;**228,243**;Mar 20, 1995
;
; IB Bill/Claims Prosthetics File (362.5)
Q
D3625 ;
NEW RCIBD,RCT,RCXVDA,RCNT,RCBILL,RCPDATA,RCPDATE
Q:'$G(RCXVD0)
S RCIBD="" S RCIBD=$$IBAREXT^IBRFN4(RCXVD0,.RCIBD)
S (RCT,RCNT)=0 F S RCT=$O(RCIBD("PRD",RCT)) Q:'RCT D
. S RCPDATA=RCIBD("PRD",RCT)
. S RCPDATE=$P(RCPDATA,U,2)
. S RCPDATE=$E($$HLDATE^HLFNC(RCPDATE),1,8)
. S RCBILL=$P(RCPDATA,U,3),RCBILL=$P($G(^DGCR(399,RCBILL,0)),U)
. S RCXVDA=RCBILL_RCXVU_$P(RCPDATA,U)_RCXVU_RCPDATE ;BILL#,ITEM,DATE
. S RCNT=RCNT+1
. S ^TMP($J,RCXVBLN,"7-362.5A",RCNT)=RCXVDA
. Q
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRCXVDC7 694 printed Nov 22, 2024@16:59:48 Page 2
RCXVDC7 ;TJK/ALBANY OI @ALTOONA, PA-AR Data Extraction Data Creation ;02-JUL-03
+1 ;;4.5;Accounts Receivable;**228,243**;Mar 20, 1995
+2 ;
+3 ; IB Bill/Claims Prosthetics File (362.5)
+4 QUIT
D3625 ;
+1 NEW RCIBD,RCT,RCXVDA,RCNT,RCBILL,RCPDATA,RCPDATE
+2 if '$GET(RCXVD0)
QUIT
+3 SET RCIBD=""
SET RCIBD=$$IBAREXT^IBRFN4(RCXVD0,.RCIBD)
+4 SET (RCT,RCNT)=0
FOR
SET RCT=$ORDER(RCIBD("PRD",RCT))
if 'RCT
QUIT
Begin DoDot:1
+5 SET RCPDATA=RCIBD("PRD",RCT)
+6 SET RCPDATE=$PIECE(RCPDATA,U,2)
+7 SET RCPDATE=$EXTRACT($$HLDATE^HLFNC(RCPDATE),1,8)
+8 SET RCBILL=$PIECE(RCPDATA,U,3)
SET RCBILL=$PIECE($GET(^DGCR(399,RCBILL,0)),U)
+9 ;BILL#,ITEM,DATE
SET RCXVDA=RCBILL_RCXVU_$PIECE(RCPDATA,U)_RCXVU_RCPDATE
+10 SET RCNT=RCNT+1
+11 SET ^TMP($JOB,RCXVBLN,"7-362.5A",RCNT)=RCXVDA
+12 QUIT
End DoDot:1
+13 QUIT
+14 ;
