- IBAMTBU ;ALB/CPM - MEANS TEST BILLING BULLETINS ; 09-DEC-91
- ;;2.0;INTEGRATED BILLING;**153**;21-MAR-94
- ;;Per VHA Directive 10-93-142, this routine should not be modified.
- ;
- PM ; Send bulletin when patient movements for a Means Test copay patient
- ; have been edited, deleted, or retro-actively added.
- ; Input: IBJOB = 3 (Edited, deleted movements)
- ; = 6 (Retro-actively added movements)
- ; DFN, DUZ, DGPMA, DGPMP
- ;
- ; - quit if a bulletin is not needed
- Q:'$$APM^IBAMTD2
- ;
- ; - generate the bulletin
- K IBT
- S IBPT=$$PT^IBEFUNC(DFN)
- S XMSUB=$E($P(IBPT,"^"),1,14)_" "_$P(IBPT,"^",3)_" - MOVEMENT CHANGE"
- S IBMTYP=$S(DGPMP="":$P(DGPMA,"^",2),1:$P(DGPMP,"^",2))
- 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")
- I IBJOB=6 S IBT(1)="A "_$S($P(DGPMA,"^",2)=6:"treating specialty",1:"transfer")_" has been retro-actively added"
- S IBT(1)=IBT(1)_" for the following patient:" S IBT(2)=" ",IBC=2
- S IBDUZ=DUZ D PAT^IBAERR1
- S Y=$S(DGPMA:+DGPMA,1:+DGPMP) D DD^%DT
- S IBC=IBC+1,IBT(IBC)=$S(IBMTYP=1:" Adm",IBMTYP=2:"Trnf",IBMTYP=3:"Disc",IBMTYP=6:"Spec",1:"Lodg")_" Date: "_Y
- S IBC=IBC+1,IBT(IBC)=" "
- ;
- ; - display before/after critical values and instructions
- D DISP^IBAMTBU1
- ;
- ; - deliver message
- D SEND
- Q
- ;
- CTPT ; Send bulletin for the discharge of a Continuous Patient.
- ; Input: DGPMA, DFN, DUZ, IBASIH, TRAN
- S IBPT=$$PT^IBEFUNC(DFN),Y=+DGPMA D D^DIQ K IBT
- S XMSUB=$E($P(IBPT,"^"),1,14)_" "_$P(IBPT,"^",3)_" - CONTINUOUS PATIENT"
- S IBT(1)="The following continuous patient was discharged on "_Y
- S IBT(2)=" ",IBC=2
- S IBDUZ=DUZ D PAT^IBAERR1
- S IBC=IBC+1,IBT(IBC)=" "
- S IBC=IBC+1,IBT(IBC)="Discharge Type: "_$S($P($G(^DG(405.1,+$P(DGPMA,"^",4),0)),"^")]"":$P(^(0),"^"),1:"TYPE UNKNOWN")
- I TRAN S IBC=IBC+1,IBT(IBC)="Transferred To: "_$S($P($G(^DIC(4,+$P(DGPMA,"^",5),0)),"^")]"":$P(^(0),"^"),1:"FACILITY UNKNOWN")
- S IBC=IBC+1,IBT(IBC)=" "
- ; - message for ASIH or non-transfers
- I 'TRAN!(IBASIH) D G SEND
- . S IBC=IBC+1 I IBASIH S IBT(IBC)="Please note that, since this patient went out on ASIH,"
- . E S IBT(IBC)="Since the patient was not transferred to another facility,"
- . S IBT(IBC)=IBT(IBC)_" the patient's"
- . S IBC=IBC+1,IBT(IBC)="discharge date was entered into the Continuous Patient file, 'unflagging'"
- . S IBC=IBC+1,IBT(IBC)="the patient as continuous. The patient will now be charged the Means Test"
- . S IBC=IBC+1,IBT(IBC)="copayment (Medicare Deductible) for any future episodes of Hospital or"
- . S IBC=IBC+1,IBT(IBC)="Nursing Home care, if s/he is Means Test copay at that time."
- . Q:IBASIH
- . S IBC=IBC+1,IBT(IBC)=" "
- . S IBC=IBC+1,IBT(IBC)="If the patient was in fact transferred, then the Discharge Date must be"
- . S IBC=IBC+1,IBT(IBC)="deleted from the Continuous Patient file."
- ;
- ; - message for transferred patients
- S IBC=IBC+1,IBT(IBC)="Please note that, since the patient was transferred to another facility,"
- S IBC=IBC+1,IBT(IBC)="the patient's discharge date was not entered into the Continuous Patient"
- S IBC=IBC+1,IBT(IBC)="file. If the patient does not receive continuous care while outside of"
- S IBC=IBC+1,IBT(IBC)="your facility, you must manually enter the date on which the patient's"
- S IBC=IBC+1,IBT(IBC)="care was discontinued into the Continuous Patient file."
- ;
- SEND ; - send message and quit.
- D MAIL^IBAERR1
- K IBVAL,IBT,IBMTYP,IBC,IBI,IBPT,XMSUB,XMY,XMTEXT,XMDUZ
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBAMTBU 3602 printed Jan 18, 2025@03:07:37 Page 2
- IBAMTBU ;ALB/CPM - MEANS TEST BILLING BULLETINS ; 09-DEC-91
- +1 ;;2.0;INTEGRATED BILLING;**153**;21-MAR-94
- +2 ;;Per VHA Directive 10-93-142, this routine should not be modified.
- +3 ;
- PM ; Send bulletin when patient movements for a Means Test copay patient
- +1 ; have been edited, deleted, or retro-actively added.
- +2 ; Input: IBJOB = 3 (Edited, deleted movements)
- +3 ; = 6 (Retro-actively added movements)
- +4 ; DFN, DUZ, DGPMA, DGPMP
- +5 ;
- +6 ; - quit if a bulletin is not needed
- +7 if '$$APM^IBAMTD2
- QUIT
- +8 ;
- +9 ; - generate the bulletin
- +10 KILL IBT
- +11 SET IBPT=$$PT^IBEFUNC(DFN)
- +12 SET XMSUB=$EXTRACT($PIECE(IBPT,"^"),1,14)_" "_$PIECE(IBPT,"^",3)_" - MOVEMENT CHANGE"
- +13 SET IBMTYP=$SELECT(DGPMP="":$PIECE(DGPMA,"^",2),1:$PIECE(DGPMP,"^",2))
- +14 IF IBJOB=3
- SET IBT(1)="A"_$SELECT(IBMTYP=1:"n admission",IBMTYP=2:" transfer",IBMTYP=3:" discharge",IBMTYP=6:" treating specialty",1:" lodger movement")_" has been "_$SELECT(DGPMA]"":"edited",1:"deleted")
- +15 IF IBJOB=6
- SET IBT(1)="A "_$SELECT($PIECE(DGPMA,"^",2)=6:"treating specialty",1:"transfer")_" has been retro-actively added"
- +16 SET IBT(1)=IBT(1)_" for the following patient:"
- SET IBT(2)=" "
- SET IBC=2
- +17 SET IBDUZ=DUZ
- DO PAT^IBAERR1
- +18 SET Y=$SELECT(DGPMA:+DGPMA,1:+DGPMP)
- DO DD^%DT
- +19 SET IBC=IBC+1
- SET IBT(IBC)=$SELECT(IBMTYP=1:" Adm",IBMTYP=2:"Trnf",IBMTYP=3:"Disc",IBMTYP=6:"Spec",1:"Lodg")_" Date: "_Y
- +20 SET IBC=IBC+1
- SET IBT(IBC)=" "
- +21 ;
- +22 ; - display before/after critical values and instructions
- +23 DO DISP^IBAMTBU1
- +24 ;
- +25 ; - deliver message
- +26 DO SEND
- +27 QUIT
- +28 ;
- CTPT ; Send bulletin for the discharge of a Continuous Patient.
- +1 ; Input: DGPMA, DFN, DUZ, IBASIH, TRAN
- +2 SET IBPT=$$PT^IBEFUNC(DFN)
- SET Y=+DGPMA
- DO D^DIQ
- KILL IBT
- +3 SET XMSUB=$EXTRACT($PIECE(IBPT,"^"),1,14)_" "_$PIECE(IBPT,"^",3)_" - CONTINUOUS PATIENT"
- +4 SET IBT(1)="The following continuous patient was discharged on "_Y
- +5 SET IBT(2)=" "
- SET IBC=2
- +6 SET IBDUZ=DUZ
- DO PAT^IBAERR1
- +7 SET IBC=IBC+1
- SET IBT(IBC)=" "
- +8 SET IBC=IBC+1
- SET IBT(IBC)="Discharge Type: "_$SELECT($PIECE($GET(^DG(405.1,+$PIECE(DGPMA,"^",4),0)),"^")]"":$PIECE(^(0),"^"),1:"TYPE UNKNOWN")
- +9 IF TRAN
- SET IBC=IBC+1
- SET IBT(IBC)="Transferred To: "_$SELECT($PIECE($GET(^DIC(4,+$PIECE(DGPMA,"^",5),0)),"^")]"":$PIECE(^(0),"^"),1:"FACILITY UNKNOWN")
- +10 SET IBC=IBC+1
- SET IBT(IBC)=" "
- +11 ; - message for ASIH or non-transfers
- +12 IF 'TRAN!(IBASIH)
- Begin DoDot:1
- +13 SET IBC=IBC+1
- IF IBASIH
- SET IBT(IBC)="Please note that, since this patient went out on ASIH,"
- +14 IF '$TEST
- SET IBT(IBC)="Since the patient was not transferred to another facility,"
- +15 SET IBT(IBC)=IBT(IBC)_" the patient's"
- +16 SET IBC=IBC+1
- SET IBT(IBC)="discharge date was entered into the Continuous Patient file, 'unflagging'"
- +17 SET IBC=IBC+1
- SET IBT(IBC)="the patient as continuous. The patient will now be charged the Means Test"
- +18 SET IBC=IBC+1
- SET IBT(IBC)="copayment (Medicare Deductible) for any future episodes of Hospital or"
- +19 SET IBC=IBC+1
- SET IBT(IBC)="Nursing Home care, if s/he is Means Test copay at that time."
- +20 if IBASIH
- QUIT
- +21 SET IBC=IBC+1
- SET IBT(IBC)=" "
- +22 SET IBC=IBC+1
- SET IBT(IBC)="If the patient was in fact transferred, then the Discharge Date must be"
- +23 SET IBC=IBC+1
- SET IBT(IBC)="deleted from the Continuous Patient file."
- End DoDot:1
- GOTO SEND
- +24 ;
- +25 ; - message for transferred patients
- +26 SET IBC=IBC+1
- SET IBT(IBC)="Please note that, since the patient was transferred to another facility,"
- +27 SET IBC=IBC+1
- SET IBT(IBC)="the patient's discharge date was not entered into the Continuous Patient"
- +28 SET IBC=IBC+1
- SET IBT(IBC)="file. If the patient does not receive continuous care while outside of"
- +29 SET IBC=IBC+1
- SET IBT(IBC)="your facility, you must manually enter the date on which the patient's"
- +30 SET IBC=IBC+1
- SET IBT(IBC)="care was discontinued into the Continuous Patient file."
- +31 ;
- SEND ; - send message and quit.
- +1 DO MAIL^IBAERR1
- +2 KILL IBVAL,IBT,IBMTYP,IBC,IBI,IBPT,XMSUB,XMY,XMTEXT,XMDUZ
- +3 QUIT