Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: RCDMC90S

RCDMC90S.m

Go to the documentation of this file. 
  1. RCDMC90S ;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 ]
  1. V ;;4.5;Accounts Receivable;**45,121**;Mar 20, 1995
  1.  ;;Per VHA Directive 10-93-142, this routine should not be modified.
  1.  ;Program to process server messages from DMC
  1.  ;1) Will automatically delete DMC flags from local system for
  1.  ;   those patients submitted to DMC that are not being followed by
  1.  ;   DMC
  1.  ;2) Will display message to DMX mailgroup when DMC receives a death
  1.  ;   notice in order that the local site can follow-up and have the
  1.  ;   death entry entered into the local patient file.
  1. READ ;READS MESSAGE INTO TEMPORARY GLOBAL
  1.  K ^TMP("RCDMC90S",$J) S XMA=0
  1. READ1 X XMREC I $D(XMER) G PROC:XMER<0
  1.  S XMA=XMA+1
  1.  S ^TMP("RCDMC90S",$J,"READ",XMA)=XMRG
  1.  G READ1
  1. PROC N DEBTOR,SSN,DDATE,LN,CNT,I,J,SITE,REC,ND,NAME,TYPE,SEQ,CNTR,LKUP,MSG
  1.  N XMDUZ,XMSUB,XMY,XMTEXT
  1.  K XMPOS,XMA,XMER,XMREC,XMRG
  1.  S CNT=2,CNTR=3,(SEQ,I)=0
  1.  F  S I=$O(^TMP("RCDMC90S",$J,"READ",I)) Q:I=""  S ND=$G(^(I)) D  Q:$P(ND,"|",2)="~"
  1.  .I $P(ND,U)="DI" S SEQ=$P(ND,U,3)
  1.  .Q:$P(ND,"^")'?1N.N
  1.  .S REC=$P(ND,"|")
  1.  .S SSN=$P(REC,U,1),DEBTOR=+$P(REC,U,3),DDATE=$P(REC,U,4),TYPE=$P(REC,U,5)
  1.  .S LKUP=$$DEBT(DEBTOR,SSN)
  1.  .I 'LKUP D  Q  ;Invalid debtor check-patch *121
  1.  ..S CNTR=CNTR+1
  1.  ..S ^TMP("RCDMC90S",$J,"BUILD",CNTR)="    "_"DEBTOR:  "_+$P(REC,U,3)_"     SSN:  "_$P(REC,U,1)
  1.  .S DEBTOR=$P(LKUP,U,2)
  1.  .;
  1.  .;Process good debtor numbers
  1.  .D CANC3^RCDMC90U(DEBTOR,1)
  1.  .S DFN=+$G(^RCD(340,DEBTOR,0)),NAME=$P(^DPT(DFN,0),U),LN="     "_$$LJ^XLFSTR(NAME,30)_"     "_SSN
  1.  .S CNT=CNT+1,^TMP("RCDMC90S",$J,"REC",CNT)=LN_$S(TYPE="01":"  INACTIVE BENEFIT",1:"  DECEASED")
  1.  .I DDATE D
  1.  ..S XMSUB="Death Notice Received From DMC"
  1.  ..S XMY("G.DMR")="",XMDUZ="AR PACKAGE",XMTEXT="MSG("
  1.  ..S MSG(1)="DMC has received a death notice for the following patient:"
  1.  ..S MSG(2)=LN_"  Date Of Death:  "_$E(DDATE,1,2)_"/"_$E(DDATE,3,4)_"/"_$E(DDATE,7,8)
  1.  ..S MSG(3)="Please follow up locally to have this information entered"
  1.  ..S MSG(4)="into the local VAMC patient file."
  1.  ..D ^XMD
  1.  ..Q
  1.  .Q
  1.  ;
  1. MSG ;SEND LIST OF PATIENTS AUTOMATICALLY DELETED
  1.  S ^TMP("RCDMC90S",$J,"REC",1)="The following debtors will not be followed by DMC"
  1.  S ^TMP("RCDMC90S",$J,"REC",2)="and are being deleted from the DMC."
  1.  S XMSUB="Patients Deleted From DMC: (SEQ. #: "_SEQ_")"
  1.  S XMY("G.DMR")="",XMDUZ="AR PACKAGE",XMTEXT="^TMP(""RCDMC90S"","_$J_",""REC"","
  1.  D ^XMD
  1.  ;
  1.  ;Send list of invalid debtors
  1.  I $D(^TMP("RCDMC90S",$J,"BUILD")) D
  1.  .S ^TMP("RCDMC90S",$J,"BUILD",1)="The following debtors have invalid debtor numbers"
  1.  .S ^TMP("RCDMC90S",$J,"BUILD",2)="Please verify the debtors"
  1.  .S ^TMP("RCDMC90S",$J,"BUILD",3)=" "
  1.  .S XMSUB="Notice of Invalid Debtor Number"
  1.  .S XMY("G.DMR")=""
  1.  .S XMDUZ="AR PACKAGE"
  1.  .S XMTEXT="^TMP(""RCDMC90S"","_$J_",""BUILD"","
  1.  .D ^XMD
  1.  .Q
  1.  ;
  1. CLEANUP ; This cleans up the ^TMP global.
  1.  K ^TMP("RCDMC90S",$J)
  1.  Q
  1.  ;
  1.  ;
  1. DEBT(DEBTOR,SSN) ;CHECK FOR VALID DEBTOR
  1.  N DFN,CHK S CHK=0
  1.  S DFN=+$G(^RCD(340,DEBTOR,0))
  1.  I DFN,SSN=$P($G(^DPT(DFN,0)),U,9) S CHK=1_U_DEBTOR
  1.  ;
  1.  ;Find debtor by SSN & match last 6 digits of debtor #
  1.  I 'CHK D
  1.  .N DEBTOR1
  1.  .S DFN=$O(^DPT("SSN",SSN,0))
  1.  .I DFN S DEBTOR1=$O(^RCD(340,"B",DFN_";DPT(",0)) D
  1.  ..I DEBTOR1,$E(DEBTOR1,$L(DEBTOR1)-5,$L(DEBTOR1))=DEBTOR S CHK=1_U_DEBTOR1
  1. DEBTQ Q CHK