source: WorldVistAEHR/trunk/r/INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IBAMTBU.m@ 1259

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

initial load of WorldVistAEHR

File size: 3.5 KB
Line 
1IBAMTBU ;ALB/CPM - MEANS TEST BILLING BULLETINS ; 09-DEC-91
2 ;;2.0;INTEGRATED BILLING;**153**;21-MAR-94
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;
5PM ; Send bulletin when patient movements for a Means Test copay patient
6 ; have been edited, deleted, or retro-actively added.
7 ; Input: IBJOB = 3 (Edited, deleted movements)
8 ; = 6 (Retro-actively added movements)
9 ; DFN, DUZ, DGPMA, DGPMP
10 ;
11 ; - quit if a bulletin is not needed
12 Q:'$$APM^IBAMTD2
13 ;
14 ; - generate the bulletin
15 K IBT
16 S IBPT=$$PT^IBEFUNC(DFN)
17 S XMSUB=$E($P(IBPT,"^"),1,14)_" "_$P(IBPT,"^",3)_" - MOVEMENT CHANGE"
18 S IBMTYP=$S(DGPMP="":$P(DGPMA,"^",2),1:$P(DGPMP,"^",2))
19 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")
20 I IBJOB=6 S IBT(1)="A "_$S($P(DGPMA,"^",2)=6:"treating specialty",1:"transfer")_" has been retro-actively added"
21 S IBT(1)=IBT(1)_" for the following patient:" S IBT(2)=" ",IBC=2
22 S IBDUZ=DUZ D PAT^IBAERR1
23 S Y=$S(DGPMA:+DGPMA,1:+DGPMP) D DD^%DT
24 S IBC=IBC+1,IBT(IBC)=$S(IBMTYP=1:" Adm",IBMTYP=2:"Trnf",IBMTYP=3:"Disc",IBMTYP=6:"Spec",1:"Lodg")_" Date: "_Y
25 S IBC=IBC+1,IBT(IBC)=" "
26 ;
27 ; - display before/after critical values and instructions
28 D DISP^IBAMTBU1
29 ;
30 ; - deliver message
31 D SEND
32 Q
33 ;
34CTPT ; Send bulletin for the discharge of a Continuous Patient.
35 ; Input: DGPMA, DFN, DUZ, IBASIH, TRAN
36 S IBPT=$$PT^IBEFUNC(DFN),Y=+DGPMA D D^DIQ K IBT
37 S XMSUB=$E($P(IBPT,"^"),1,14)_" "_$P(IBPT,"^",3)_" - CONTINUOUS PATIENT"
38 S IBT(1)="The following continuous patient was discharged on "_Y
39 S IBT(2)=" ",IBC=2
40 S IBDUZ=DUZ D PAT^IBAERR1
41 S IBC=IBC+1,IBT(IBC)=" "
42 S IBC=IBC+1,IBT(IBC)="Discharge Type: "_$S($P($G(^DG(405.1,+$P(DGPMA,"^",4),0)),"^")]"":$P(^(0),"^"),1:"TYPE UNKNOWN")
43 I TRAN S IBC=IBC+1,IBT(IBC)="Transferred To: "_$S($P($G(^DIC(4,+$P(DGPMA,"^",5),0)),"^")]"":$P(^(0),"^"),1:"FACILITY UNKNOWN")
44 S IBC=IBC+1,IBT(IBC)=" "
45 ; - message for ASIH or non-transfers
46 I 'TRAN!(IBASIH) D G SEND
47 . S IBC=IBC+1 I IBASIH S IBT(IBC)="Please note that, since this patient went out on ASIH,"
48 . E S IBT(IBC)="Since the patient was not transferred to another facility,"
49 . S IBT(IBC)=IBT(IBC)_" the patient's"
50 . S IBC=IBC+1,IBT(IBC)="discharge date was entered into the Continuous Patient file, 'unflagging'"
51 . S IBC=IBC+1,IBT(IBC)="the patient as continuous. The patient will now be charged the Means Test"
52 . S IBC=IBC+1,IBT(IBC)="copayment (Medicare Deductible) for any future episodes of Hospital or"
53 . S IBC=IBC+1,IBT(IBC)="Nursing Home care, if s/he is Means Test copay at that time."
54 . Q:IBASIH
55 . S IBC=IBC+1,IBT(IBC)=" "
56 . S IBC=IBC+1,IBT(IBC)="If the patient was in fact transferred, then the Discharge Date must be"
57 . S IBC=IBC+1,IBT(IBC)="deleted from the Continuous Patient file."
58 ;
59 ; - message for transferred patients
60 S IBC=IBC+1,IBT(IBC)="Please note that, since the patient was transferred to another facility,"
61 S IBC=IBC+1,IBT(IBC)="the patient's discharge date was not entered into the Continuous Patient"
62 S IBC=IBC+1,IBT(IBC)="file. If the patient does not receive continuous care while outside of"
63 S IBC=IBC+1,IBT(IBC)="your facility, you must manually enter the date on which the patient's"
64 S IBC=IBC+1,IBT(IBC)="care was discontinued into the Continuous Patient file."
65 ;
66SEND ; - send message and quit.
67 D MAIL^IBAERR1
68 K IBVAL,IBT,IBMTYP,IBC,IBI,IBPT,XMSUB,XMY,XMTEXT,XMDUZ
69 Q
Note: See TracBrowser for help on using the repository browser.