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

IBAMTBU.m

Go to the documentation of this file.
  1. IBAMTBU ;ALB/CPM - MEANS TEST BILLING BULLETINS ; 09-DEC-91
  1. ;;2.0;INTEGRATED BILLING;**153**;21-MAR-94
  1. ;;Per VHA Directive 10-93-142, this routine should not be modified.
  1. ;
  1. PM ; Send bulletin when patient movements for a Means Test copay patient
  1. ; have been edited, deleted, or retro-actively added.
  1. ; Input: IBJOB = 3 (Edited, deleted movements)
  1. ; = 6 (Retro-actively added movements)
  1. ; DFN, DUZ, DGPMA, DGPMP
  1. ;
  1. ; - quit if a bulletin is not needed
  1. Q:'$$APM^IBAMTD2
  1. ;
  1. ; - generate the bulletin
  1. K IBT
  1. S IBPT=$$PT^IBEFUNC(DFN)
  1. S XMSUB=$E($P(IBPT,"^"),1,14)_" "_$P(IBPT,"^",3)_" - MOVEMENT CHANGE"
  1. S IBMTYP=$S(DGPMP="":$P(DGPMA,"^",2),1:$P(DGPMP,"^",2))
  1. I IBJOB=3 S IBT(1)="A"_$S(IBMTYP=1:"n admission",IBMTYP=2:" transfer",IBMTYP=3:" discharge",IBMTYP=6:" treating specialty",1:" lodger movement")_" has been "_$S(DGPMA]"":"edited",1:"deleted")
  1. I IBJOB=6 S IBT(1)="A "_$S($P(DGPMA,"^",2)=6:"treating specialty",1:"transfer")_" has been retro-actively added"
  1. S IBT(1)=IBT(1)_" for the following patient:" S IBT(2)=" ",IBC=2
  1. S IBDUZ=DUZ D PAT^IBAERR1
  1. S Y=$S(DGPMA:+DGPMA,1:+DGPMP) D DD^%DT
  1. S IBC=IBC+1,IBT(IBC)=$S(IBMTYP=1:" Adm",IBMTYP=2:"Trnf",IBMTYP=3:"Disc",IBMTYP=6:"Spec",1:"Lodg")_" Date: "_Y
  1. S IBC=IBC+1,IBT(IBC)=" "
  1. ;
  1. ; - display before/after critical values and instructions
  1. D DISP^IBAMTBU1
  1. ;
  1. ; - deliver message
  1. D SEND
  1. Q
  1. ;
  1. CTPT ; Send bulletin for the discharge of a Continuous Patient.
  1. ; Input: DGPMA, DFN, DUZ, IBASIH, TRAN
  1. S IBPT=$$PT^IBEFUNC(DFN),Y=+DGPMA D D^DIQ K IBT
  1. S XMSUB=$E($P(IBPT,"^"),1,14)_" "_$P(IBPT,"^",3)_" - CONTINUOUS PATIENT"
  1. S IBT(1)="The following continuous patient was discharged on "_Y
  1. S IBT(2)=" ",IBC=2
  1. S IBDUZ=DUZ D PAT^IBAERR1
  1. S IBC=IBC+1,IBT(IBC)=" "
  1. S IBC=IBC+1,IBT(IBC)="Discharge Type: "_$S($P($G(^DG(405.1,+$P(DGPMA,"^",4),0)),"^")]"":$P(^(0),"^"),1:"TYPE UNKNOWN")
  1. I TRAN S IBC=IBC+1,IBT(IBC)="Transferred To: "_$S($P($G(^DIC(4,+$P(DGPMA,"^",5),0)),"^")]"":$P(^(0),"^"),1:"FACILITY UNKNOWN")
  1. S IBC=IBC+1,IBT(IBC)=" "
  1. ; - message for ASIH or non-transfers
  1. I 'TRAN!(IBASIH) D G SEND
  1. . S IBC=IBC+1 I IBASIH S IBT(IBC)="Please note that, since this patient went out on ASIH,"
  1. . E S IBT(IBC)="Since the patient was not transferred to another facility,"
  1. . S IBT(IBC)=IBT(IBC)_" the patient's"
  1. . S IBC=IBC+1,IBT(IBC)="discharge date was entered into the Continuous Patient file, 'unflagging'"
  1. . S IBC=IBC+1,IBT(IBC)="the patient as continuous. The patient will now be charged the Means Test"
  1. . S IBC=IBC+1,IBT(IBC)="copayment (Medicare Deductible) for any future episodes of Hospital or"
  1. . S IBC=IBC+1,IBT(IBC)="Nursing Home care, if s/he is Means Test copay at that time."
  1. . Q:IBASIH
  1. . S IBC=IBC+1,IBT(IBC)=" "
  1. . S IBC=IBC+1,IBT(IBC)="If the patient was in fact transferred, then the Discharge Date must be"
  1. . S IBC=IBC+1,IBT(IBC)="deleted from the Continuous Patient file."
  1. ;
  1. ; - message for transferred patients
  1. S IBC=IBC+1,IBT(IBC)="Please note that, since the patient was transferred to another facility,"
  1. S IBC=IBC+1,IBT(IBC)="the patient's discharge date was not entered into the Continuous Patient"
  1. S IBC=IBC+1,IBT(IBC)="file. If the patient does not receive continuous care while outside of"
  1. S IBC=IBC+1,IBT(IBC)="your facility, you must manually enter the date on which the patient's"
  1. S IBC=IBC+1,IBT(IBC)="care was discontinued into the Continuous Patient file."
  1. ;
  1. SEND ; - send message and quit.
  1. D MAIL^IBAERR1
  1. K IBVAL,IBT,IBMTYP,IBC,IBI,IBPT,XMSUB,XMY,XMTEXT,XMDUZ
  1. Q