Routine: RCXVDC10

RCXVDC10 ;ALBANY OI@ALTOONA,PA/TJK-AR Data Extraction Data Creation ;08/18/05

 ;;4.5;Accounts Receivable;**232**;Mar 20, 1995

 ;  Monthly transmissions

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

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),!

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,!

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,!

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

HIST ;entry point from post-init for historical job

 D EN1

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRCXVDC10   2739     printed  Mar 13, 2025@20:54:11                                                                                                                                                                                                    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

RCXVDC10.m