RCXVDC10 ;ALBANY OI@ALTOONA,PA/TJK-AR Data Extraction Data Creation ;08/18/05
;;4.5;Accounts Receivable;**232**;Mar 20, 1995
;
; Monthly transmissions
Q
EN ;Entry point from nightly process to set up monthly batch jobs
N RCXVMO,RCXVDA,IENARRAY,RCDA
S X1=$E(DT,1,5)_"01",X2=-1 D C^%DTC S RCXVMO=$E(X,1,5)_"00"
EN1 ;branch point for historical job
F RCXVBTY="P","B","I" K RCXVDA,IENARRAY D NBT^RCXVDEQ S RCDA(RCXVBTY)=RCXVDA
S RCXVDA=RCDA("I"),$P(^RCXV(RCXVDA,0),U,10)=RCXVMO D D3547A
S RCXVDA=RCDA("P"),$P(^RCXV(RCXVDA,4),U)=RCXVMO
S RCXVDA=RCDA("B"),$P(^RCXV(RCXVDA,5),U)=RCXVMO
Q
D3547 ;IB Patient Copay account data
;DFN,RCXVBTN defined in routine RCXVTSK
;RCXVBTN=Internal number of batch file in ^RCXV(
N I,RCFLAG,RCXVDA,RCXVMO,SSN,RCXVDT,RCXVCO,VADM
S RCXVMO=$P(^RCXV(RCXVBTN,0),U,10)
S (I,RCFLAG)=0 F S I=$O(^IBAM(354.7,DFN,1,I)) Q:'I S RCXVCO=$G(^(I,0)) D Q:RCFLAG
. I +RCXVCO=RCXVMO S RCFLAG=1
. Q
Q:'RCFLAG
; Write data into FTP file
D DEM^VADPT S SSN=$P(VADM(2),U)
S RCXVDT=$P(RCXVCO,U),RCXVDA=SSN_RCXVU_$E($$HLDATE^HLFNC(RCXVDT),1,8)
S RCXVDA=RCXVDA_RCXVU_$P(RCXVCO,U,2)
S X=$P(RCXVCO,U,3),X=$S(X=1:"YES",X=2:"OVER",1:"NO")
S RCXVDA=RCXVDA_RCXVU_X_RCXVU_$P(RCXVCO,U,4)
S ^TMP($J,"RCXVDC10",DFN)=RCXVDA
W "REC:"_$P(RCXVDA,RCXVU,1),!
W "354.7:"_$P(RCXVDA,RCXVU,2,5),!
Q
PREREG ;Pre-Registration
N IBDATA,X1,X2,IBEDT,IBBDT,RCXVDA
S IBBDT=$E(RCXVMO,1,5)_"01",IBEDT=$$ENDT(IBBDT)
S IBDATA=$$PREREG^IBRFN4(IBBDT,IBEDT)
S RCXVDA=$E($$HLDATE^HLFNC(IBBDT),1,8)
S RCXVDA=RCXVDA_RCXVU_$E($$HLDATE^HLFNC(IBEDT),1,8)_RCXVU_IBDATA
S ^TMP($J,"RCXVDC10","PRE-REG")=RCXVDA
W "PRE-REG:"_RCXVDA,!
Q
BUFFER ;Insurance buffer
S IBBDT=$E(RCXVMO,1,5)_"01",IBEDT=$$ENDT(IBBDT)
S IBDATA=$$BUFFER^IBRFN4(IBBDT,IBEDT)
S RCXVDA=$E($$HLDATE^HLFNC(IBBDT),1,8)
S RCXVDA=RCXVDA_RCXVU_$E($$HLDATE^HLFNC(IBEDT),1,8)_RCXVU_IBDATA
S ^TMP($J,"RCXVDC10","BUFFER")=RCXVDA
W "BUFFER:"_RCXVDA,!
Q
ENDT(IBBDT) ;Calculates end date
S X1=IBBDT,X2=+31 D C^%DTC
S X1=$E(X,1,5)_"01",X2=-1 D C^%DTC
Q X
D3547A ;Sets Patient list from 354.7 into 348.4
N I,DFN,RCXVDA
S RCXVDA=RCDA("I")
F I=0,1,2 D
. S DFN=0 F S DFN=$O(^IBAM(354.7,"AC",RCXVMO,I,DFN)) Q:'DFN D
. . D FIL^RCXVDEQ("I")
. . ; If this patient already exists in this batch, quit
. . I $D(^RCXV(RCXVDA,3,DFN)) Q
. . ;; File record
. . NEW DIC,DIE,X,DA,DLAYGO,Y,DINUM
. . S DA(1)=RCXVDA,DIC="^RCXV("_DA(1)_",3,",DIE=DIC,(X,DINUM)=DFN
. . S DLAYGO=348.43,DIC(0)="L",DIC("P")=DLAYGO
. . I '$D(^RCXV(DA(1),3,0)) S ^RCXV(DA(1),3,0)="^348.43^^"
. . D FILE^DICN
. . Q
. Q
S $P(^RCXV(RCXVDA,0),U,10)=RCXVMO
;
Q
HIST ;entry point from post-init for historical job
D EN1
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRCXVDC10 2739 printed Dec 13, 2024@01:49:30 Page 2
RCXVDC10 ;ALBANY OI@ALTOONA,PA/TJK-AR Data Extraction Data Creation ;08/18/05
+1 ;;4.5;Accounts Receivable;**232**;Mar 20, 1995
+2 ;
+3 ; Monthly transmissions
+4 QUIT
EN ;Entry point from nightly process to set up monthly batch jobs
+1 NEW RCXVMO,RCXVDA,IENARRAY,RCDA
+2 SET X1=$EXTRACT(DT,1,5)_"01"
SET X2=-1
DO C^%DTC
SET RCXVMO=$EXTRACT(X,1,5)_"00"
EN1 ;branch point for historical job
+1 FOR RCXVBTY="P","B","I"
KILL RCXVDA,IENARRAY
DO NBT^RCXVDEQ
SET RCDA(RCXVBTY)=RCXVDA
+2 SET RCXVDA=RCDA("I")
SET $PIECE(^RCXV(RCXVDA,0),U,10)=RCXVMO
DO D3547A
+3 SET RCXVDA=RCDA("P")
SET $PIECE(^RCXV(RCXVDA,4),U)=RCXVMO
+4 SET RCXVDA=RCDA("B")
SET $PIECE(^RCXV(RCXVDA,5),U)=RCXVMO
+5 QUIT
D3547 ;IB Patient Copay account data
+1 ;DFN,RCXVBTN defined in routine RCXVTSK
+2 ;RCXVBTN=Internal number of batch file in ^RCXV(
+3 NEW I,RCFLAG,RCXVDA,RCXVMO,SSN,RCXVDT,RCXVCO,VADM
+4 SET RCXVMO=$PIECE(^RCXV(RCXVBTN,0),U,10)
+5 SET (I,RCFLAG)=0
FOR
SET I=$ORDER(^IBAM(354.7,DFN,1,I))
if 'I
QUIT
SET RCXVCO=$GET(^(I,0))
Begin DoDot:1
+6 IF +RCXVCO=RCXVMO
SET RCFLAG=1
+7 QUIT
End DoDot:1
if RCFLAG
QUIT
+8 if 'RCFLAG
QUIT
+9 ; Write data into FTP file
+10 DO DEM^VADPT
SET SSN=$PIECE(VADM(2),U)
+11 SET RCXVDT=$PIECE(RCXVCO,U)
SET RCXVDA=SSN_RCXVU_$EXTRACT($$HLDATE^HLFNC(RCXVDT),1,8)
+12 SET RCXVDA=RCXVDA_RCXVU_$PIECE(RCXVCO,U,2)
+13 SET X=$PIECE(RCXVCO,U,3)
SET X=$SELECT(X=1:"YES",X=2:"OVER",1:"NO")
+14 SET RCXVDA=RCXVDA_RCXVU_X_RCXVU_$PIECE(RCXVCO,U,4)
+15 SET ^TMP($JOB,"RCXVDC10",DFN)=RCXVDA
+16 WRITE "REC:"_$PIECE(RCXVDA,RCXVU,1),!
+17 WRITE "354.7:"_$PIECE(RCXVDA,RCXVU,2,5),!
+18 QUIT
PREREG ;Pre-Registration
+1 NEW IBDATA,X1,X2,IBEDT,IBBDT,RCXVDA
+2 SET IBBDT=$EXTRACT(RCXVMO,1,5)_"01"
SET IBEDT=$$ENDT(IBBDT)
+3 SET IBDATA=$$PREREG^IBRFN4(IBBDT,IBEDT)
+4 SET RCXVDA=$EXTRACT($$HLDATE^HLFNC(IBBDT),1,8)
+5 SET RCXVDA=RCXVDA_RCXVU_$EXTRACT($$HLDATE^HLFNC(IBEDT),1,8)_RCXVU_IBDATA
+6 SET ^TMP($JOB,"RCXVDC10","PRE-REG")=RCXVDA
+7 WRITE "PRE-REG:"_RCXVDA,!
+8 QUIT
BUFFER ;Insurance buffer
+1 SET IBBDT=$EXTRACT(RCXVMO,1,5)_"01"
SET IBEDT=$$ENDT(IBBDT)
+2 SET IBDATA=$$BUFFER^IBRFN4(IBBDT,IBEDT)
+3 SET RCXVDA=$EXTRACT($$HLDATE^HLFNC(IBBDT),1,8)
+4 SET RCXVDA=RCXVDA_RCXVU_$EXTRACT($$HLDATE^HLFNC(IBEDT),1,8)_RCXVU_IBDATA
+5 SET ^TMP($JOB,"RCXVDC10","BUFFER")=RCXVDA
+6 WRITE "BUFFER:"_RCXVDA,!
+7 QUIT
ENDT(IBBDT) ;Calculates end date
+1 SET X1=IBBDT
SET X2=+31
DO C^%DTC
+2 SET X1=$EXTRACT(X,1,5)_"01"
SET X2=-1
DO C^%DTC
+3 QUIT X
D3547A ;Sets Patient list from 354.7 into 348.4
+1 NEW I,DFN,RCXVDA
+2 SET RCXVDA=RCDA("I")
+3 FOR I=0,1,2
Begin DoDot:1
+4 SET DFN=0
FOR
SET DFN=$ORDER(^IBAM(354.7,"AC",RCXVMO,I,DFN))
if 'DFN
QUIT
Begin DoDot:2
+5 DO FIL^RCXVDEQ("I")
+6 ; If this patient already exists in this batch, quit
+7 IF $DATA(^RCXV(RCXVDA,3,DFN))
QUIT
+8 ;; File record
+9 NEW DIC,DIE,X,DA,DLAYGO,Y,DINUM
+10 SET DA(1)=RCXVDA
SET DIC="^RCXV("_DA(1)_",3,"
SET DIE=DIC
SET (X,DINUM)=DFN
+11 SET DLAYGO=348.43
SET DIC(0)="L"
SET DIC("P")=DLAYGO
+12 IF '$DATA(^RCXV(DA(1),3,0))
SET ^RCXV(DA(1),3,0)="^348.43^^"
+13 DO FILE^DICN
+14 QUIT
End DoDot:2
+15 QUIT
End DoDot:1
+16 SET $PIECE(^RCXV(RCXVDA,0),U,10)=RCXVMO
+17 ;
+18 QUIT
HIST ;entry point from post-init for historical job
+1 DO EN1
+2 QUIT
