- RCDPRPL4 ;WISC/RFJ/PJH-receipt profile listmanager options ;1 Apr 01
- ;;4.5;Accounts Receivable;**169,172,173,269,276,326,332**;Mar 20, 1995;Build 40
- ;;Per VA Directive 6402, this routine should not be modified.
- Q
- ;
- ; this routine contains the entry points for receipt management
- ;
- ;
- ONLINE ; allow the supervisor to mark the CR document as input on line
- ;
- ; Input - RCRECDA - IEN of CR receipt in #344
- ;
- D FULL^VALM1
- S VALMBCK="R"
- ;
- ; get fms document and status
- N %,FMSDOC,GECSDATA
- S FMSDOC=$$FMSSTAT^RCDPUREC(RCRECTDA)
- ;
- W !!,"This option will allow you to mark a rejected Cash Receipt document as"
- W !,"entered on line. This will prevent the document from being listed on"
- W !,"the nightly mailman message used to help manage the receipts and deposits."
- ;
- W !!,"FMS Cash Receipt Document: ",$P(FMSDOC,"^"),?48,"Status: ",$P(FMSDOC,"^",2)
- ;
- I '$D(^XUSEC("PRCAY PAYMENT SUP",DUZ)) W !!,"You are not an owner of the supervisor PRCAY PAYMENT SUP security key." D QUIT Q
- ;
- ; cr accepted
- I $E($P(FMSDOC,"^",2))="A" W !!,"You CANNOT mark the Cash Receipt document as entered on line.",!,"The CR document is ACCEPTED ??" D QUIT Q
- ;
- ; not been transmitted for 2 days
- I $E($P(FMSDOC,"^",2))="T",$$FMDIFF^XLFDT(DT,$P(^RCY(344,RCRECTDA,0),"^",8))'>2 W !!,"You CANNOT mark the Cash Receipt document as entered on line.",!,"The CR document has NOT been TRANSMITTED for 2 days ??" D QUIT Q
- ;
- ; cr queued for transmission
- I $E($P(FMSDOC,"^",2))="Q"!($E($P(FMSDOC,"^",2))="M") W !!,"You CANNOT mark the Cash Receipt document as entered on line.",!,"The CR document is waiting to be TRANSMITTED ??" D QUIT Q
- ;
- ; check to see if already marked as entered on line
- I $E($P(FMSDOC,"^",2))="O" D Q
- . I $$ASKSTAT("REMOVE")'=1 Q
- . W !,"... removing CR status as entered on line ..."
- . ; remove the ON-LINE status on field 201
- . D EDITREC^RCDPUREC(RCRECTDA,"201///0")
- . ; show the new status
- . S FMSDOC=$$FMSSTAT^RCDPUREC(RCRECTDA)
- . W !!,"FMS Cash Receipt Document: ",$P(FMSDOC,"^"),?48,"Status: ",$P(FMSDOC,"^",2)
- . D QUIT
- ;
- ; ask to change the status to entered on line
- I $$ASKSTAT("ENTER")'=1 D QUIT Q
- ;
- ; change the status to entered on line
- W !!,"... changing status to entered on line ..."
- W !,"... changing the generic code sheet stack file status to ACCEPTED ..."
- ;
- ; set the status to entered on line in field 201
- D EDITREC^RCDPUREC(RCRECTDA,"201///1")
- ;
- ; set the generic code sheet status as accepted
- ; get the document ien
- D DATA^GECSSGET($P(FMSDOC,"^"))
- I $G(GECSDATA) D SETSTAT^GECSSTAA(GECSDATA,"A")
- ;
- ; show the new status
- S FMSDOC=$$FMSSTAT^RCDPUREC(RCRECTDA)
- W !!,"FMS Cash Receipt Document: ",$P(FMSDOC,"^"),?48,"Status: ",$P(FMSDOC,"^",2)
- ;
- QUIT ; pause and rebuild the header
- W !!,"press RETURN to continue: "
- R %:DTIME
- D HDR^RCDPRPLM
- Q
- ;
- ;
- ASKSTAT(ACTION) ; ask if its okay to remove or change the entered online status
- ; 1 is yes, otherwise no
- N DIR,DIQ2,DTOUT,DUOUT,X,Y
- S DIR(0)="YO",DIR("B")="NO"
- S DIR("A",1)=" Do you want to "_ACTION_" the status showing the Cash Receipt"
- S DIR("A")=" document was entered ON LINE"
- D ^DIR
- I $G(DTOUT)!($G(DUOUT)) S Y=-1
- Q Y
- ;
- ERAWL(RCSCR) ; Generate automatic dec adj from ERA Worklist in RCSCR
- ; RCADJ returned = 1 if passed by reference and adjustment successful
- ; returned = 2 if passed by ref and adjustments aborted
- ; returned = -1 if error
- ; returned = 0 if no WL adjustments found
- N RCZ,RCZ0,Z00,V00,RCCOM,RC1,RCADJ,RCOK,WLA
- S RC1=1,RCZ=0,RCADJ=0
- F S RCZ=$O(^RCY(344.49,RCSCR,1,RCZ)) Q:'RCZ!(RCADJ=2) S V00=$G(^(RCZ,0)),RCZ0=0 F S RCZ0=$O(^RCY(344.49,RCSCR,1,RCZ,1,RCZ0)) Q:'RCZ0!(RCADJ=2) S Z00=$G(^(RCZ0,0)) Q:"12"'[+$P(Z00,U,5) D
- . S RCCOM(1)=$P(Z00,U,9)
- . I RC1,$P(Z00,U,5)=1 D Q:RCADJ=2
- .. S RC1=0
- .. S DIR(0)="YA",DIR("B")="YES",DIR("A",1)="Generating automatic decrease adjustments from EDI Lbox Worklist ...",DIR("A")="ARE YOU SURE YOU WANT TO CONTINUE?: "
- .. D ^DIR K DIR
- .. I Y'=1 S RCADJ=2
- . I $P(Z00,U,8)=1 D Q ; previously done
- .. I $P(Z00,U,5)=1 W !," Automatic decrease adj from ERA Worklist for bill #"_$P($G(^PRCA(430,+$P(V00,U,7),0)),U),!," for amount of "_$J(+$P(Z00,U,3),"",2)_" was previously completed" S RCADJ=1
- . I $P(Z00,U,5)=1 D Q ; Decrease adj
- .. S WLA=$$INCDEC^RCBEUTR1($P(V00,U,7),$P(Z00,U,3),.RCCOM,,,1) I 'WLA D
- ... ; PRCA276 - $$INCDEC can now return "0^1" which means a negative claim balance could have occurred if the decrease adjustment was applied to the claim
- ... S RCADJ=-1 W !," Could not perform automatic decrease adj from ERA Worklist for ",!," bill # "_$P($G(^PRCA(430,+$P(V00,U,7),0)),U)_" for amount of "_$J(+$P(Z00,U,3),"",2)
- ... I $P(WLA,U,2) D
- .... S RCADJ=2
- .... W !,"WARNING: Receipt cannot be processed.",!,"Processing this receipt will cause this bill to have a negative balance",!,"which is outside the scope of VA Accounting regulations."
- .... W !,"Correct the error and reprocess this receipt."
- .. E D ; success
- ... D UPD(RCSCR,RCZ,RCZ0)
- ... S RCADJ=1
- ... W !," EDI Lbox Worklist automatic dec adjustment made to "_$P($G(^PRCA(430,+$P(V00,U,7),0)),U)_": "_$J(+$P(Z00,U,3),"",2)
- . I $P(Z00,U,5)=2 D Q ; Bill comment
- .. D ADDCOMM^RCBEUTRA($P(V00,U,7),.RCCOM),UPD(RCSCR,RCZ,RCZ0)
- ;
- Q $G(RCADJ)
- ;
- UPD(RCSCR,Z,Z0) ; Mark as complete so it doesn't get done twice
- N DA,DIE,DR
- S DA(2)=RCSCR,DA(1)=Z,DA=Z0
- S DIE="^RCY(344.49,"_DA(2)_",1,"_DA(1)_",1,",DR=".08////1" D ^DIE
- Q
- ;
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRCDPRPL4 5588 printed Feb 18, 2025@23:12:42 Page 2
- RCDPRPL4 ;WISC/RFJ/PJH-receipt profile listmanager options ;1 Apr 01
- +1 ;;4.5;Accounts Receivable;**169,172,173,269,276,326,332**;Mar 20, 1995;Build 40
- +2 ;;Per VA Directive 6402, this routine should not be modified.
- +3 QUIT
- +4 ;
- +5 ; this routine contains the entry points for receipt management
- +6 ;
- +7 ;
- ONLINE ; allow the supervisor to mark the CR document as input on line
- +1 ;
- +2 ; Input - RCRECDA - IEN of CR receipt in #344
- +3 ;
- +4 DO FULL^VALM1
- +5 SET VALMBCK="R"
- +6 ;
- +7 ; get fms document and status
- +8 NEW %,FMSDOC,GECSDATA
- +9 SET FMSDOC=$$FMSSTAT^RCDPUREC(RCRECTDA)
- +10 ;
- +11 WRITE !!,"This option will allow you to mark a rejected Cash Receipt document as"
- +12 WRITE !,"entered on line. This will prevent the document from being listed on"
- +13 WRITE !,"the nightly mailman message used to help manage the receipts and deposits."
- +14 ;
- +15 WRITE !!,"FMS Cash Receipt Document: ",$PIECE(FMSDOC,"^"),?48,"Status: ",$PIECE(FMSDOC,"^",2)
- +16 ;
- +17 IF '$DATA(^XUSEC("PRCAY PAYMENT SUP",DUZ))
- WRITE !!,"You are not an owner of the supervisor PRCAY PAYMENT SUP security key."
- DO QUIT
- QUIT
- +18 ;
- +19 ; cr accepted
- +20 IF $EXTRACT($PIECE(FMSDOC,"^",2))="A"
- WRITE !!,"You CANNOT mark the Cash Receipt document as entered on line.",!,"The CR document is ACCEPTED ??"
- DO QUIT
- QUIT
- +21 ;
- +22 ; not been transmitted for 2 days
- +23 IF $EXTRACT($PIECE(FMSDOC,"^",2))="T"
- IF $$FMDIFF^XLFDT(DT,$PIECE(^RCY(344,RCRECTDA,0),"^",8))'>2
- WRITE !!,"You CANNOT mark the Cash Receipt document as entered on line.",!,"The CR document has NOT been TRANSMITTED for 2 days ??"
- DO QUIT
- QUIT
- +24 ;
- +25 ; cr queued for transmission
- +26 IF $EXTRACT($PIECE(FMSDOC,"^",2))="Q"!($EXTRACT($PIECE(FMSDOC,"^",2))="M")
- WRITE !!,"You CANNOT mark the Cash Receipt document as entered on line.",!,"The CR document is waiting to be TRANSMITTED ??"
- DO QUIT
- QUIT
- +27 ;
- +28 ; check to see if already marked as entered on line
- +29 IF $EXTRACT($PIECE(FMSDOC,"^",2))="O"
- Begin DoDot:1
- +30 IF $$ASKSTAT("REMOVE")'=1
- QUIT
- +31 WRITE !,"... removing CR status as entered on line ..."
- +32 ; remove the ON-LINE status on field 201
- +33 DO EDITREC^RCDPUREC(RCRECTDA,"201///0")
- +34 ; show the new status
- +35 SET FMSDOC=$$FMSSTAT^RCDPUREC(RCRECTDA)
- +36 WRITE !!,"FMS Cash Receipt Document: ",$PIECE(FMSDOC,"^"),?48,"Status: ",$PIECE(FMSDOC,"^",2)
- +37 DO QUIT
- End DoDot:1
- QUIT
- +38 ;
- +39 ; ask to change the status to entered on line
- +40 IF $$ASKSTAT("ENTER")'=1
- DO QUIT
- QUIT
- +41 ;
- +42 ; change the status to entered on line
- +43 WRITE !!,"... changing status to entered on line ..."
- +44 WRITE !,"... changing the generic code sheet stack file status to ACCEPTED ..."
- +45 ;
- +46 ; set the status to entered on line in field 201
- +47 DO EDITREC^RCDPUREC(RCRECTDA,"201///1")
- +48 ;
- +49 ; set the generic code sheet status as accepted
- +50 ; get the document ien
- +51 DO DATA^GECSSGET($PIECE(FMSDOC,"^"))
- +52 IF $GET(GECSDATA)
- DO SETSTAT^GECSSTAA(GECSDATA,"A")
- +53 ;
- +54 ; show the new status
- +55 SET FMSDOC=$$FMSSTAT^RCDPUREC(RCRECTDA)
- +56 WRITE !!,"FMS Cash Receipt Document: ",$PIECE(FMSDOC,"^"),?48,"Status: ",$PIECE(FMSDOC,"^",2)
- +57 ;
- QUIT ; pause and rebuild the header
- +1 WRITE !!,"press RETURN to continue: "
- +2 READ %:DTIME
- +3 DO HDR^RCDPRPLM
- +4 QUIT
- +5 ;
- +6 ;
- ASKSTAT(ACTION) ; ask if its okay to remove or change the entered online status
- +1 ; 1 is yes, otherwise no
- +2 NEW DIR,DIQ2,DTOUT,DUOUT,X,Y
- +3 SET DIR(0)="YO"
- SET DIR("B")="NO"
- +4 SET DIR("A",1)=" Do you want to "_ACTION_" the status showing the Cash Receipt"
- +5 SET DIR("A")=" document was entered ON LINE"
- +6 DO ^DIR
- +7 IF $GET(DTOUT)!($GET(DUOUT))
- SET Y=-1
- +8 QUIT Y
- +9 ;
- ERAWL(RCSCR) ; Generate automatic dec adj from ERA Worklist in RCSCR
- +1 ; RCADJ returned = 1 if passed by reference and adjustment successful
- +2 ; returned = 2 if passed by ref and adjustments aborted
- +3 ; returned = -1 if error
- +4 ; returned = 0 if no WL adjustments found
- +5 NEW RCZ,RCZ0,Z00,V00,RCCOM,RC1,RCADJ,RCOK,WLA
- +6 SET RC1=1
- SET RCZ=0
- SET RCADJ=0
- +7 FOR
- SET RCZ=$ORDER(^RCY(344.49,RCSCR,1,RCZ))
- if 'RCZ!(RCADJ=2)
- QUIT
- SET V00=$GET(^(RCZ,0))
- SET RCZ0=0
- FOR
- SET RCZ0=$ORDER(^RCY(344.49,RCSCR,1,RCZ,1,RCZ0))
- if 'RCZ0!(RCADJ=2)
- QUIT
- SET Z00=$GET(^(RCZ0,0))
- if "12"'[+$PIECE(Z00,U,5)
- QUIT
- Begin DoDot:1
- +8 SET RCCOM(1)=$PIECE(Z00,U,9)
- +9 IF RC1
- IF $PIECE(Z00,U,5)=1
- Begin DoDot:2
- +10 SET RC1=0
- +11 SET DIR(0)="YA"
- SET DIR("B")="YES"
- SET DIR("A",1)="Generating automatic decrease adjustments from EDI Lbox Worklist ..."
- SET DIR("A")="ARE YOU SURE YOU WANT TO CONTINUE?: "
- +12 DO ^DIR
- KILL DIR
- +13 IF Y'=1
- SET RCADJ=2
- End DoDot:2
- if RCADJ=2
- QUIT
- +14 ; previously done
- IF $PIECE(Z00,U,8)=1
- Begin DoDot:2
- +15 IF $PIECE(Z00,U,5)=1
- WRITE !," Automatic decrease adj from ERA Worklist for bill #"_$PIECE($GET(^PRCA(430,+$PIECE(V00,U,7),0)),U),!," for amount of "_$JUSTIFY(+$PIECE(Z00,U,3),"",2)_" was previously completed"
- SET RCADJ=1
- End DoDot:2
- QUIT
- +16 ; Decrease adj
- IF $PIECE(Z00,U,5)=1
- Begin DoDot:2
- +17 SET WLA=$$INCDEC^RCBEUTR1($PIECE(V00,U,7),$PIECE(Z00,U,3),.RCCOM,,,1)
- IF 'WLA
- Begin DoDot:3
- +18 ; PRCA276 - $$INCDEC can now return "0^1" which means a negative claim balance could have occurred if the decrease adjustment was applied to the claim
- +19 SET RCADJ=-1
- WRITE !," Could not perform automatic decrease adj from ERA Worklist for ",!," bill # "_$PIECE($GET(^PRCA(430,+$PIECE(V00,U,7),0)),U)_" for amount of "_$JUSTIFY(+$PIECE(Z00,U,3),"",2)
- +20 IF $PIECE(WLA,U,2)
- Begin DoDot:4
- +21 SET RCADJ=2
- +22 WRITE !,"WARNING: Receipt cannot be processed.",!,"Processing this receipt will cause this bill to have a negative balance",!,"which is outside the scope of VA Accounting regulations."
- +23 WRITE !,"Correct the error and reprocess this receipt."
- End DoDot:4
- End DoDot:3
- +24 ; success
- IF '$TEST
- Begin DoDot:3
- +25 DO UPD(RCSCR,RCZ,RCZ0)
- +26 SET RCADJ=1
- +27 WRITE !," EDI Lbox Worklist automatic dec adjustment made to "_$PIECE($GET(^PRCA(430,+$PIECE(V00,U,7),0)),U)_": "_$JUSTIFY(+$PIECE(Z00,U,3),"",2)
- End DoDot:3
- End DoDot:2
- QUIT
- +28 ; Bill comment
- IF $PIECE(Z00,U,5)=2
- Begin DoDot:2
- +29 DO ADDCOMM^RCBEUTRA($PIECE(V00,U,7),.RCCOM)
- DO UPD(RCSCR,RCZ,RCZ0)
- End DoDot:2
- QUIT
- End DoDot:1
- +30 ;
- +31 QUIT $GET(RCADJ)
- +32 ;
- UPD(RCSCR,Z,Z0) ; Mark as complete so it doesn't get done twice
- +1 NEW DA,DIE,DR
- +2 SET DA(2)=RCSCR
- SET DA(1)=Z
- SET DA=Z0
- +3 SET DIE="^RCY(344.49,"_DA(2)_",1,"_DA(1)_",1,"
- SET DR=".08////1"
- DO ^DIE
- +4 QUIT
- +5 ;