source: WorldVistAEHR/trunk/r/ACCOUNTS_RECEIVABLE-PRCA-PRY-RC/RCDMC90S.m@ 1714

Last change on this file since 1714 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 3.2 KB
Line 
1RCDMC90S ;WASH IRMFO@ALTOONA,PA/TJK-DMC 90 DAY (SERVER) ;7/17/97 8:11 AM ; 10/24/96 3:21 PM [ 02/24/97 12:17 PM ]
2V ;;4.5;Accounts Receivable;**45,121**;Mar 20, 1995
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;Program to process server messages from DMC
5 ;1) Will automatically delete DMC flags from local system for
6 ; those patients submitted to DMC that are not being followed by
7 ; DMC
8 ;2) Will display message to DMX mailgroup when DMC receives a death
9 ; notice in order that the local site can follow-up and have the
10 ; death entry entered into the local patient file.
11READ ;READS MESSAGE INTO TEMPORARY GLOBAL
12 K ^TMP("RCDMC90S",$J) S XMA=0
13READ1 X XMREC I $D(XMER) G PROC:XMER<0
14 S XMA=XMA+1
15 S ^TMP("RCDMC90S",$J,"READ",XMA)=XMRG
16 G READ1
17PROC N DEBTOR,SSN,DDATE,LN,CNT,I,J,SITE,REC,ND,NAME,TYPE,SEQ,CNTR,LKUP,MSG
18 N XMDUZ,XMSUB,XMY,XMTEXT
19 K XMPOS,XMA,XMER,XMREC,XMRG
20 S CNT=2,CNTR=3,(SEQ,I)=0
21 F S I=$O(^TMP("RCDMC90S",$J,"READ",I)) Q:I="" S ND=$G(^(I)) D Q:$P(ND,"|",2)="~"
22 .I $P(ND,U)="DI" S SEQ=$P(ND,U,3)
23 .Q:$P(ND,"^")'?1N.N
24 .S REC=$P(ND,"|")
25 .S SSN=$P(REC,U,1),DEBTOR=+$P(REC,U,3),DDATE=$P(REC,U,4),TYPE=$P(REC,U,5)
26 .S LKUP=$$DEBT(DEBTOR,SSN)
27 .I 'LKUP D Q ;Invalid debtor check-patch *121
28 ..S CNTR=CNTR+1
29 ..S ^TMP("RCDMC90S",$J,"BUILD",CNTR)=" "_"DEBTOR: "_+$P(REC,U,3)_" SSN: "_$P(REC,U,1)
30 .S DEBTOR=$P(LKUP,U,2)
31 .;
32 .;Process good debtor numbers
33 .D CANC3^RCDMC90U(DEBTOR,1)
34 .S DFN=+$G(^RCD(340,DEBTOR,0)),NAME=$P(^DPT(DFN,0),U),LN=" "_$$LJ^XLFSTR(NAME,30)_" "_SSN
35 .S CNT=CNT+1,^TMP("RCDMC90S",$J,"REC",CNT)=LN_$S(TYPE="01":" INACTIVE BENEFIT",1:" DECEASED")
36 .I DDATE D
37 ..S XMSUB="Death Notice Received From DMC"
38 ..S XMY("G.DMR")="",XMDUZ="AR PACKAGE",XMTEXT="MSG("
39 ..S MSG(1)="DMC has received a death notice for the following patient:"
40 ..S MSG(2)=LN_" Date Of Death: "_$E(DDATE,1,2)_"/"_$E(DDATE,3,4)_"/"_$E(DDATE,7,8)
41 ..S MSG(3)="Please follow up locally to have this information entered"
42 ..S MSG(4)="into the local VAMC patient file."
43 ..D ^XMD
44 ..Q
45 .Q
46 ;
47MSG ;SEND LIST OF PATIENTS AUTOMATICALLY DELETED
48 S ^TMP("RCDMC90S",$J,"REC",1)="The following debtors will not be followed by DMC"
49 S ^TMP("RCDMC90S",$J,"REC",2)="and are being deleted from the DMC."
50 S XMSUB="Patients Deleted From DMC: (SEQ. #: "_SEQ_")"
51 S XMY("G.DMR")="",XMDUZ="AR PACKAGE",XMTEXT="^TMP(""RCDMC90S"","_$J_",""REC"","
52 D ^XMD
53 ;
54 ;Send list of invalid debtors
55 I $D(^TMP("RCDMC90S",$J,"BUILD")) D
56 .S ^TMP("RCDMC90S",$J,"BUILD",1)="The following debtors have invalid debtor numbers"
57 .S ^TMP("RCDMC90S",$J,"BUILD",2)="Please verify the debtors"
58 .S ^TMP("RCDMC90S",$J,"BUILD",3)=" "
59 .S XMSUB="Notice of Invalid Debtor Number"
60 .S XMY("G.DMR")=""
61 .S XMDUZ="AR PACKAGE"
62 .S XMTEXT="^TMP(""RCDMC90S"","_$J_",""BUILD"","
63 .D ^XMD
64 .Q
65 ;
66CLEANUP ; This cleans up the ^TMP global.
67 K ^TMP("RCDMC90S",$J)
68 Q
69 ;
70 ;
71DEBT(DEBTOR,SSN) ;CHECK FOR VALID DEBTOR
72 N DFN,CHK S CHK=0
73 S DFN=+$G(^RCD(340,DEBTOR,0))
74 I DFN,SSN=$P($G(^DPT(DFN,0)),U,9) S CHK=1_U_DEBTOR
75 ;
76 ;Find debtor by SSN & match last 6 digits of debtor #
77 I 'CHK D
78 .N DEBTOR1
79 .S DFN=$O(^DPT("SSN",SSN,0))
80 .I DFN S DEBTOR1=$O(^RCD(340,"B",DFN_";DPT(",0)) D
81 ..I DEBTOR1,$E(DEBTOR1,$L(DEBTOR1)-5,$L(DEBTOR1))=DEBTOR S CHK=1_U_DEBTOR1
82DEBTQ Q CHK
Note: See TracBrowser for help on using the repository browser.