IBAMTBU ;ALB/CPM - MEANS TEST BILLING BULLETINS ; 09-DEC-91
;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94
;;Per VHA Directive 10-93-142, this routine should not be modified.
;
PM ; Send bulletin when patient movements for a Category C 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 Category"
. S IBC=IBC+1,IBT(IBC)="C copayment (Medicare Deductible) for any future episodes of Hospital or"
. S IBC=IBC+1,IBT(IBC)="Nursing Home care, if s/he is Category C 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
IBAMTBU ;ALB/CPM - MEANS TEST BILLING BULLETINS ; 09-DEC-91
+1 ;;Version 2.0 ; INTEGRATED BILLING ;; 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 Category C 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 Category"
+18 SET IBC=IBC+1
SET IBT(IBC)="C 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 Category C 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
