- RCDMB1MT ;ALB/MR-REPAYMENT PLAN MONITOR ;16-AUG-00
- ;;4.5;Accounts Receivable;**167,171,188**;Mar 20, 1995
- ;
- EN ; - Entry point for this program (Called by PRCABJ - AR Nightly Process)
- N BILL,CNT,DATA,DFN,FLG,I,J,LINE,RCPT,PTDA,RCAR,RCAT,RCDA,RCDB,RCRP,RPDT
- N TXT,TYPE,X
- ;
- K ^TMP("RCDMBDAT",$J)
- ;
- ; - Find data required for report.
- S RCDA=""
- F S RCDA=$O(^PRCA(430,"AC",16,RCDA)) Q:'RCDA D
- . S RCAR=$G(^PRCA(430,RCDA,0)) Q:'RCAR
- . I '$P($G(^PRCA(430,RCDA,4)),"^") Q ; No Repayment Plan
- . S RCAT=+$P(RCAR,"^",2) ; Gets AR category.
- . S RCDB=$P(RCAR,"^",9) ; Gets the pointer to the Debtor file (#340)
- . S RCPT=$$PAT(RCDB) Q:RCPT="" ; Gets patient info.
- . S DFN=$P(RCPT,"^",4) ; Gets the pointer to the Patient file (#2)
- . S RCRP=$$RP(RCDA,RCDB) ; Defaulted Repymt.Plan/New Bill entered
- . I 'RCRP,'$P(RCRP,"^",2) Q ; Neither case was found
- . ;
- . ; - Sets the temporary global
- . I $P(RCRP,"^") D ; Defaulted on the Repayment Plan
- . . S ^TMP("RCDMBDAT",$J,1,DFN)=RCPT
- . . S ^TMP("RCDMBDAT",$J,1,DFN,$P(RCAR,"^"))=""
- . I $P(RCRP,"^",2) D ; Had a new bill entered
- . . S ^TMP("RCDMBDAT",$J,2,DFN)=RCPT
- . . S X=""
- . . F S X=$O(^TMP("RCDMBDAT",$J,"BILL",X)) Q:X="" D
- . . . S ^TMP("RCDMBDAT",$J,2,DFN,X)=""
- . . K ^TMP("RCDMBDAT",$J,"BILL")
- ;
- ; - No cases to report were found
- S LINE=0 I '$D(^TMP("RCDMBDAT",$J)) G SND
- ;
- ; - Formats and set the data on ^TMP("RCDMBMSG",$J)
- K ^TMP("RCDMBMSG",$J)
- S (TYPE,PTDA,BILL)="",LINE=1
- F S TYPE=$O(^TMP("RCDMBDAT",$J,TYPE)) Q:TYPE="" D
- . ;
- . ; - Prints the Header (Name SSN...) and updates LINE
- . D HDR(TYPE,.LINE) S CNT=0
- . F S PTDA=$O(^TMP("RCDMBDAT",$J,TYPE,PTDA)) Q:PTDA="" D
- . . S DATA=$G(^TMP("RCDMBDAT",$J,TYPE,PTDA))
- . . S CNT=CNT+1,X=""
- . . S $E(X,1)=$P(DATA,"^") ; Debtor Name
- . . S $E(X,38)=$P(DATA,"^",2) ; SSN
- . . S $E(X,51)=$P(DATA,"^",3) ; Phone Number
- . . S FLG=0 I $P(DATA,"^",5)'="" S FLG=1 ; Date of Death
- . . F S BILL=$O(^TMP("RCDMBDAT",$J,TYPE,PTDA,BILL)) Q:BILL="" D
- . . . I FLG,X="" S $E(X,6)="DOD: "_$P(DATA,"^",5),FLG=0
- . . . S $E(X,65)=BILL ; Bill Number
- . . . S ^TMP("RCDMBMSG",$J,LINE)=X,X=""
- . . . S LINE=LINE+1
- . . I FLG D
- . . . S ^TMP("RCDMBMSG",$J,LINE)=" DOD: "_$P(DATA,"^",5)
- . . . S LINE=LINE+1
- . I CNT'>1 Q
- . S ^TMP("RCDMBMSG",$J,LINE)="",LINE=LINE+1 ; Skip a line
- . S ^TMP("RCDMBMSG",$J,LINE)="Total of "_CNT_" debtor(s)",LINE=LINE+1
- . S ^TMP("RCDMBMSG",$J,LINE)="",LINE=LINE+1 ; Skip a line
- ;
- SND ; - If one of the two situations or none of them were found, it will
- ; informed in the e-mail
- ;
- F I=1,2 D
- . I $D(^TMP("RCDMBDAT",$J,I)) Q
- . F J=1:1:3 S LINE=LINE+1,^TMP("RCDMBMSG",$J,LINE)=""
- . I I=1 D Q
- . . S ^TMP("RCDMBMSG",$J,LINE)="There were no debtors who defaulted on their repayment plan yesterday."
- . S ^TMP("RCDMBMSG",$J,LINE)="There were no debtors with repayment plans who had new active bills yesterday."
- ;
- D XMD ; Sends the Mailman message
- ;
- ENQ K ^TMP("RCDMBDAT",$J),^TMP("RCDMBMSG",$J)
- Q
- ;
- XMD ; Sets the Mailman variables and send the message
- N DUZ,XMSUB,XMDUZ,XMY,XMDUN,XMMG,XMSCR,XMTEXT,XMZ
- ;
- S XMSUB="AR REPAYMENT PLAN MONITOR",XMDUZ="AR PACKAGE"
- S XMY("G.RC REPAY PLANS")="",XMTEXT="^TMP(""RCDMBMSG"","_$J_","
- ;
- D ^XMD
- ;
- Q
- ;
- PAT(DEB) ; - Returns Debtor information
- ; Input: DEB=AR pointer to Debtor file (#340)
- ; Output: Name ^ SSN ^ Phone Number ^ Pointer to Patient file ^
- ; Date of Death (MM/DD/YY)
- ;
- N DEATH,DEBTOR,DFN,NAME,PHONE,SSN,VA,VADM,VAERR,VAPA
- I 'DEB Q ""
- S DEBTOR=$G(^RCD(340,DEB,0)) I $P(DEBTOR,"^")'["DPT" Q ""
- S DFN=+DEBTOR
- D DEM^VADPT S NAME=VADM(1),SSN=$P(VADM(2),"^",2),DEATH=$P(VADM(6),".")
- I DEATH'="" S DEATH=$$DAT(DEATH)
- D ADD^VADPT S PHONE=VAPA(8)
- ;
- Q (NAME_"^"_SSN_"^"_PHONE_"^"_DFN_"^"_DEATH)
- ;
- RP(X,DEB) ; - Checks if a Repayment Plan became defaulted or if a new
- ; bill has been entered to a patient under a Repayment Plan established
- ; Input: X=Pointer to the AR file #430
- ; DEB=Pointer to the Detor file #340
- ; Output: Y=Defaulted? (1-YES/0-NO) ^ New bill entered? (1-YES/0-NO) ^
- ; Bill(s) # separated by "," (If piece 2 = 1)
- ;
- N ARZ,DEF,ELM,I,NEW,NPMT,RCBL,RP,YST
- ;
- S (DEF,NEW)=0
- S RP=$G(^PRCA(430,X,4)),NPMT=$P(RP,"^",4),YST=$$HTFM^XLFDT($H-1,1)
- ;
- ; - Checks if the patient defaulted on his Repayment Plan
- F I=1:1:NPMT D Q:DEF
- . S ELM=$G(^PRCA(430,X,5,I,0)) Q:ELM=""
- . I $P(ELM,"^",2) Q
- . I $$FMDIFF^XLFDT(YST,$P(ELM,"^"))=1 D Q
- . . S DEF=1
- ;
- ; Checks if a Bill became active for the debtor yesterday
- S RCBL=""
- F S RCBL=$O(^PRCA(430,"C",DEB,RCBL)) Q:RCBL="" D
- . I RCBL=X Q
- . S ARZ=$G(^PRCA(430,RCBL,0))
- . I $P(ARZ,"^",8)'=16!($P(ARZ,"^",14)'=YST) Q
- . S NEW=1,^TMP("RCDMBDAT",$J,"BILL",$P($G(^PRCA(430,RCBL,0)),"^"))=""
- Q (DEF_"^"_NEW)
- ;
- HDR(TP,LN) ; Sets the temporary global with the header of the E-mail
- ; Input: TP=Type of problem (1-Defaulted / 2-New bill)
- ; LN=Next line to be set on the ^TMP("RCDMBMSG",$J,LN) global
- ;
- N X,I
- I TP=1 D
- . S ^TMP("RCDMBMSG",$J,LN)="The following debtors just defaulted on a Repayment Plan by not making a"
- . S LN=LN+1
- . S ^TMP("RCDMBMSG",$J,LN)="scheduled payment on or before the scheduled payment date: "
- I TP=2 D
- . F I=1,2 S ^TMP("RCDMBMSG",$J,LN)="",LN=LN+1
- . S ^TMP("RCDMBMSG",$J,LN)="The following debtors with a Repayment Plan had a new active bill entered: "
- ;
- S LN=LN+1,^TMP("RCDMBMSG",$J,LN)=""
- S X="",$E(X,1)="Name",$E(X,38)="SSN",$E(X,51)="Phone Number"
- S $E(X,65)=$S(TP=1:"Bill",1:"New Bill")
- S LN=LN+1,^TMP("RCDMBMSG",$J,LN)=X
- S X="",$P(X,"=",79)="" S LN=LN+1,^TMP("RCDMBMSG",$J,LN)=X
- S LN=LN+1
- Q
- ;
- DAT(DAT) ;Changes date from FM to MM/DD/YYYY
- N YR
- S YR=DAT\10000+1700
- Q $E(DAT,4,5)_"/"_$E(DAT,6,7)_"/"_YR
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRCDMB1MT 5946 printed Mar 13, 2025@20:48:01 Page 2
- RCDMB1MT ;ALB/MR-REPAYMENT PLAN MONITOR ;16-AUG-00
- +1 ;;4.5;Accounts Receivable;**167,171,188**;Mar 20, 1995
- +2 ;
- EN ; - Entry point for this program (Called by PRCABJ - AR Nightly Process)
- +1 NEW BILL,CNT,DATA,DFN,FLG,I,J,LINE,RCPT,PTDA,RCAR,RCAT,RCDA,RCDB,RCRP,RPDT
- +2 NEW TXT,TYPE,X
- +3 ;
- +4 KILL ^TMP("RCDMBDAT",$JOB)
- +5 ;
- +6 ; - Find data required for report.
- +7 SET RCDA=""
- +8 FOR
- SET RCDA=$ORDER(^PRCA(430,"AC",16,RCDA))
- if 'RCDA
- QUIT
- Begin DoDot:1
- +9 SET RCAR=$GET(^PRCA(430,RCDA,0))
- if 'RCAR
- QUIT
- +10 ; No Repayment Plan
- IF '$PIECE($GET(^PRCA(430,RCDA,4)),"^")
- QUIT
- +11 ; Gets AR category.
- SET RCAT=+$PIECE(RCAR,"^",2)
- +12 ; Gets the pointer to the Debtor file (#340)
- SET RCDB=$PIECE(RCAR,"^",9)
- +13 ; Gets patient info.
- SET RCPT=$$PAT(RCDB)
- if RCPT=""
- QUIT
- +14 ; Gets the pointer to the Patient file (#2)
- SET DFN=$PIECE(RCPT,"^",4)
- +15 ; Defaulted Repymt.Plan/New Bill entered
- SET RCRP=$$RP(RCDA,RCDB)
- +16 ; Neither case was found
- IF 'RCRP
- IF '$PIECE(RCRP,"^",2)
- QUIT
- +17 ;
- +18 ; - Sets the temporary global
- +19 ; Defaulted on the Repayment Plan
- IF $PIECE(RCRP,"^")
- Begin DoDot:2
- +20 SET ^TMP("RCDMBDAT",$JOB,1,DFN)=RCPT
- +21 SET ^TMP("RCDMBDAT",$JOB,1,DFN,$PIECE(RCAR,"^"))=""
- End DoDot:2
- +22 ; Had a new bill entered
- IF $PIECE(RCRP,"^",2)
- Begin DoDot:2
- +23 SET ^TMP("RCDMBDAT",$JOB,2,DFN)=RCPT
- +24 SET X=""
- +25 FOR
- SET X=$ORDER(^TMP("RCDMBDAT",$JOB,"BILL",X))
- if X=""
- QUIT
- Begin DoDot:3
- +26 SET ^TMP("RCDMBDAT",$JOB,2,DFN,X)=""
- End DoDot:3
- +27 KILL ^TMP("RCDMBDAT",$JOB,"BILL")
- End DoDot:2
- End DoDot:1
- +28 ;
- +29 ; - No cases to report were found
- +30 SET LINE=0
- IF '$DATA(^TMP("RCDMBDAT",$JOB))
- GOTO SND
- +31 ;
- +32 ; - Formats and set the data on ^TMP("RCDMBMSG",$J)
- +33 KILL ^TMP("RCDMBMSG",$JOB)
- +34 SET (TYPE,PTDA,BILL)=""
- SET LINE=1
- +35 FOR
- SET TYPE=$ORDER(^TMP("RCDMBDAT",$JOB,TYPE))
- if TYPE=""
- QUIT
- Begin DoDot:1
- +36 ;
- +37 ; - Prints the Header (Name SSN...) and updates LINE
- +38 DO HDR(TYPE,.LINE)
- SET CNT=0
- +39 FOR
- SET PTDA=$ORDER(^TMP("RCDMBDAT",$JOB,TYPE,PTDA))
- if PTDA=""
- QUIT
- Begin DoDot:2
- +40 SET DATA=$GET(^TMP("RCDMBDAT",$JOB,TYPE,PTDA))
- +41 SET CNT=CNT+1
- SET X=""
- +42 ; Debtor Name
- SET $EXTRACT(X,1)=$PIECE(DATA,"^")
- +43 ; SSN
- SET $EXTRACT(X,38)=$PIECE(DATA,"^",2)
- +44 ; Phone Number
- SET $EXTRACT(X,51)=$PIECE(DATA,"^",3)
- +45 ; Date of Death
- SET FLG=0
- IF $PIECE(DATA,"^",5)'=""
- SET FLG=1
- +46 FOR
- SET BILL=$ORDER(^TMP("RCDMBDAT",$JOB,TYPE,PTDA,BILL))
- if BILL=""
- QUIT
- Begin DoDot:3
- +47 IF FLG
- IF X=""
- SET $EXTRACT(X,6)="DOD: "_$PIECE(DATA,"^",5)
- SET FLG=0
- +48 ; Bill Number
- SET $EXTRACT(X,65)=BILL
- +49 SET ^TMP("RCDMBMSG",$JOB,LINE)=X
- SET X=""
- +50 SET LINE=LINE+1
- End DoDot:3
- +51 IF FLG
- Begin DoDot:3
- +52 SET ^TMP("RCDMBMSG",$JOB,LINE)=" DOD: "_$PIECE(DATA,"^",5)
- +53 SET LINE=LINE+1
- End DoDot:3
- End DoDot:2
- +54 IF CNT'>1
- QUIT
- +55 ; Skip a line
- SET ^TMP("RCDMBMSG",$JOB,LINE)=""
- SET LINE=LINE+1
- +56 SET ^TMP("RCDMBMSG",$JOB,LINE)="Total of "_CNT_" debtor(s)"
- SET LINE=LINE+1
- +57 ; Skip a line
- SET ^TMP("RCDMBMSG",$JOB,LINE)=""
- SET LINE=LINE+1
- End DoDot:1
- +58 ;
- SND ; - If one of the two situations or none of them were found, it will
- +1 ; informed in the e-mail
- +2 ;
- +3 FOR I=1,2
- Begin DoDot:1
- +4 IF $DATA(^TMP("RCDMBDAT",$JOB,I))
- QUIT
- +5 FOR J=1:1:3
- SET LINE=LINE+1
- SET ^TMP("RCDMBMSG",$JOB,LINE)=""
- +6 IF I=1
- Begin DoDot:2
- +7 SET ^TMP("RCDMBMSG",$JOB,LINE)="There were no debtors who defaulted on their repayment plan yesterday."
- End DoDot:2
- QUIT
- +8 SET ^TMP("RCDMBMSG",$JOB,LINE)="There were no debtors with repayment plans who had new active bills yesterday."
- End DoDot:1
- +9 ;
- +10 ; Sends the Mailman message
- DO XMD
- +11 ;
- ENQ KILL ^TMP("RCDMBDAT",$JOB),^TMP("RCDMBMSG",$JOB)
- +1 QUIT
- +2 ;
- XMD ; Sets the Mailman variables and send the message
- +1 NEW DUZ,XMSUB,XMDUZ,XMY,XMDUN,XMMG,XMSCR,XMTEXT,XMZ
- +2 ;
- +3 SET XMSUB="AR REPAYMENT PLAN MONITOR"
- SET XMDUZ="AR PACKAGE"
- +4 SET XMY("G.RC REPAY PLANS")=""
- SET XMTEXT="^TMP(""RCDMBMSG"","_$JOB_","
- +5 ;
- +6 DO ^XMD
- +7 ;
- +8 QUIT
- +9 ;
- PAT(DEB) ; - Returns Debtor information
- +1 ; Input: DEB=AR pointer to Debtor file (#340)
- +2 ; Output: Name ^ SSN ^ Phone Number ^ Pointer to Patient file ^
- +3 ; Date of Death (MM/DD/YY)
- +4 ;
- +5 NEW DEATH,DEBTOR,DFN,NAME,PHONE,SSN,VA,VADM,VAERR,VAPA
- +6 IF 'DEB
- QUIT ""
- +7 SET DEBTOR=$GET(^RCD(340,DEB,0))
- IF $PIECE(DEBTOR,"^")'["DPT"
- QUIT ""
- +8 SET DFN=+DEBTOR
- +9 DO DEM^VADPT
- SET NAME=VADM(1)
- SET SSN=$PIECE(VADM(2),"^",2)
- SET DEATH=$PIECE(VADM(6),".")
- +10 IF DEATH'=""
- SET DEATH=$$DAT(DEATH)
- +11 DO ADD^VADPT
- SET PHONE=VAPA(8)
- +12 ;
- +13 QUIT (NAME_"^"_SSN_"^"_PHONE_"^"_DFN_"^"_DEATH)
- +14 ;
- RP(X,DEB) ; - Checks if a Repayment Plan became defaulted or if a new
- +1 ; bill has been entered to a patient under a Repayment Plan established
- +2 ; Input: X=Pointer to the AR file #430
- +3 ; DEB=Pointer to the Detor file #340
- +4 ; Output: Y=Defaulted? (1-YES/0-NO) ^ New bill entered? (1-YES/0-NO) ^
- +5 ; Bill(s) # separated by "," (If piece 2 = 1)
- +6 ;
- +7 NEW ARZ,DEF,ELM,I,NEW,NPMT,RCBL,RP,YST
- +8 ;
- +9 SET (DEF,NEW)=0
- +10 SET RP=$GET(^PRCA(430,X,4))
- SET NPMT=$PIECE(RP,"^",4)
- SET YST=$$HTFM^XLFDT($HOROLOG-1,1)
- +11 ;
- +12 ; - Checks if the patient defaulted on his Repayment Plan
- +13 FOR I=1:1:NPMT
- Begin DoDot:1
- +14 SET ELM=$GET(^PRCA(430,X,5,I,0))
- if ELM=""
- QUIT
- +15 IF $PIECE(ELM,"^",2)
- QUIT
- +16 IF $$FMDIFF^XLFDT(YST,$PIECE(ELM,"^"))=1
- Begin DoDot:2
- +17 SET DEF=1
- End DoDot:2
- QUIT
- End DoDot:1
- if DEF
- QUIT
- +18 ;
- +19 ; Checks if a Bill became active for the debtor yesterday
- +20 SET RCBL=""
- +21 FOR
- SET RCBL=$ORDER(^PRCA(430,"C",DEB,RCBL))
- if RCBL=""
- QUIT
- Begin DoDot:1
- +22 IF RCBL=X
- QUIT
- +23 SET ARZ=$GET(^PRCA(430,RCBL,0))
- +24 IF $PIECE(ARZ,"^",8)'=16!($PIECE(ARZ,"^",14)'=YST)
- QUIT
- +25 SET NEW=1
- SET ^TMP("RCDMBDAT",$JOB,"BILL",$PIECE($GET(^PRCA(430,RCBL,0)),"^"))=""
- End DoDot:1
- +26 QUIT (DEF_"^"_NEW)
- +27 ;
- HDR(TP,LN) ; Sets the temporary global with the header of the E-mail
- +1 ; Input: TP=Type of problem (1-Defaulted / 2-New bill)
- +2 ; LN=Next line to be set on the ^TMP("RCDMBMSG",$J,LN) global
- +3 ;
- +4 NEW X,I
- +5 IF TP=1
- Begin DoDot:1
- +6 SET ^TMP("RCDMBMSG",$JOB,LN)="The following debtors just defaulted on a Repayment Plan by not making a"
- +7 SET LN=LN+1
- +8 SET ^TMP("RCDMBMSG",$JOB,LN)="scheduled payment on or before the scheduled payment date: "
- End DoDot:1
- +9 IF TP=2
- Begin DoDot:1
- +10 FOR I=1,2
- SET ^TMP("RCDMBMSG",$JOB,LN)=""
- SET LN=LN+1
- +11 SET ^TMP("RCDMBMSG",$JOB,LN)="The following debtors with a Repayment Plan had a new active bill entered: "
- End DoDot:1
- +12 ;
- +13 SET LN=LN+1
- SET ^TMP("RCDMBMSG",$JOB,LN)=""
- +14 SET X=""
- SET $EXTRACT(X,1)="Name"
- SET $EXTRACT(X,38)="SSN"
- SET $EXTRACT(X,51)="Phone Number"
- +15 SET $EXTRACT(X,65)=$SELECT(TP=1:"Bill",1:"New Bill")
- +16 SET LN=LN+1
- SET ^TMP("RCDMBMSG",$JOB,LN)=X
- +17 SET X=""
- SET $PIECE(X,"=",79)=""
- SET LN=LN+1
- SET ^TMP("RCDMBMSG",$JOB,LN)=X
- +18 SET LN=LN+1
- +19 QUIT
- +20 ;
- DAT(DAT) ;Changes date from FM to MM/DD/YYYY
- +1 NEW YR
- +2 SET YR=DAT\10000+1700
- +3 QUIT $EXTRACT(DAT,4,5)_"/"_$EXTRACT(DAT,6,7)_"/"_YR
