IBECEA34 ;ALB/CPM - Cancel/Edit/Add... Fee Support ; 12-FEB-96
;;2.0;INTEGRATED BILLING;**57,677,734**;21-MAR-94;Build 4
;;Per VHA Directive 10-93-142, this routine should not be modified.
;
NOEVT ; No event in Integrated Billing - ask user to select a Non-VA ptf ;IB*2.0*734 messages at tag +1,+3,&+4
W !,"You may link this charge to one of the patient's Non-VA PTF entries..."
S IBDG=$$ADSEL(DFN)
I 'IBDG W !!,"This patient has no Non-VA PTF entries -- this charge cannot be added." S IBY=-1 G NOEVTQ
I IBDG=-1 W !!,"No Non-VA PTF entry selected -- transaction cannot be completed." S IBY=-1 G NOEVTQ
W !!,"I will need to build an event record in Integrated Billing for this charge."
;
; - build softlink and set event date
S IBSL="45:"_+IBDG,IBEVDT=$P(IBDG,"^",2),IBFEEV=1
NOEVTQ Q
;
;
ADSEL(DFN) ; Select a Non-VA PTF as an admission to use to build an event.
; Input: DFN -- Pointer to the patient in file #2
; Output: >1 -- ien of ptf entry (in file #45) to link event
; 0 -- no feee ptf entries for the patient, or
; -1 -- user decided to quit.
I '$D(^DGPT("AFEE",+$G(DFN))) Q 0
N ARR,PTF,IBD,IBQ,J,SEL,X,QF S IBQ=0,IBD="",QF="" ;IB*2.0*734
F J=1:1 S IBD=$O(^DGPT("AFEE",DFN,IBD)) Q:'IBD D ;IB*2.0*734
. S PTF=+$O(^(IBD,0)) I '$D(^DGPT(PTF,0)) Q ;IB*2.0*734
. W:J=1 !!," Please select one of the following Non-VA Care PTF entries:" ; ;IB*2.0*734
. S ARR(J)=PTF_"^"_(IBD\1) W !?3,J D DISEL,ASKAD:'(J#5) I IBQ!($D(SEL)) S QF=1 Q ;IB*2.0*734
I '$D(ARR) S QF=1 ;IB*2.0*734
I QF'=1 D ;IB*2.0*734
. I '((J-1)#5) W !!?3,"End of list.",! ;IB*2.0*734
. S J=J-1 D ASKAD ;IB*2.0*734
Q $S('$D(ARR):0,IBQ!'$D(SEL):-1,1:SEL) ;IB*2.0*734
;
DISEL ; Display admission data.
N DGPT S DGPT=$G(^DGPT(PTF,0))
W ?7,$$DAT2^IBOUTL($P(DGPT,"^",2))
I $G(^DGPT(PTF,70)) W ?32,"(Discharged: ",$$DAT2^IBOUTL(+^(70)),")"
Q
;
ASKAD ; Prompt the user to select an admission.
W !," Select 1-",J," or type '^' to quit: " R X:DTIME S:'$T!(X["^") IBQ=1 I IBQ!(X="") G ASKADQ
I '$D(ARR(+X)) W !!?3,*7,"Enter a NUMBER from 1-",J,".",! G ASKAD
S IBDIS=+$G(^DGPT(+ARR(+X),70))\1 S:'IBDIS IBDIS=DT
I IBFR'<$P(ARR(+X),"^",2),IBTO'>IBDIS S SEL=ARR(+X) G ASKADQ
W !!?3,*7,"The bill dates fall outside the admissions dates!",! G ASKAD
ASKADQ K IBDIS
Q
;
;
ADEV ; Add a new event entry for the Non-VA PTF in file #350.
W !!,"Building the Non-VA Care PTF event record... " ;IB*2.0*734
N DIE,DR,DA
D EVADD^IBAUTL3 K IBN,IBEVDT Q:IBY<0 W "done."
S DIE="^IB(",DA=IBEVDA,DR=".05////2" D ^DIE
S $P(^IB(IBEVDA,0),"^",8)="FEE ADMISSION"
Q
;
;
MED ; Is the Fee Charge for a CNH or Contract Hospital Admission?
R !," Is this a C(N)H or Contract (H)ospital Admission? CNH// ",X:DTIME
I '$T!(X["^") S IBY=-1 G MEDQ
S:X="" X="N" S X=$E(X)
I "NHnh"'[X D HMED G MED
W $S("nN"[X:" CNH",1:" CONTRACT HOSPITAL")
S IBADJMED=1 I "Hh"[X S IBADJMED=2,IBMED=IBMED/2
MEDQ Q
;
HMED ; Help for the 'C(N)H or Contract (H)ospital' prompt
W !!?6,"Enter: '<CR>' - If the charge is for a CNH Admission"
W !?14,"'H' - If the charge is for a Contract Hospital Admission"
W !?14,"'^' - To quit this option",!
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBECEA34 3236 printed Oct 16, 2024@18:21:59 Page 2
IBECEA34 ;ALB/CPM - Cancel/Edit/Add... Fee Support ; 12-FEB-96
+1 ;;2.0;INTEGRATED BILLING;**57,677,734**;21-MAR-94;Build 4
+2 ;;Per VHA Directive 10-93-142, this routine should not be modified.
+3 ;
NOEVT ; No event in Integrated Billing - ask user to select a Non-VA ptf ;IB*2.0*734 messages at tag +1,+3,&+4
+1 WRITE !,"You may link this charge to one of the patient's Non-VA PTF entries..."
+2 SET IBDG=$$ADSEL(DFN)
+3 IF 'IBDG
WRITE !!,"This patient has no Non-VA PTF entries -- this charge cannot be added."
SET IBY=-1
GOTO NOEVTQ
+4 IF IBDG=-1
WRITE !!,"No Non-VA PTF entry selected -- transaction cannot be completed."
SET IBY=-1
GOTO NOEVTQ
+5 WRITE !!,"I will need to build an event record in Integrated Billing for this charge."
+6 ;
+7 ; - build softlink and set event date
+8 SET IBSL="45:"_+IBDG
SET IBEVDT=$PIECE(IBDG,"^",2)
SET IBFEEV=1
NOEVTQ QUIT
+1 ;
+2 ;
ADSEL(DFN) ; Select a Non-VA PTF as an admission to use to build an event.
+1 ; Input: DFN -- Pointer to the patient in file #2
+2 ; Output: >1 -- ien of ptf entry (in file #45) to link event
+3 ; 0 -- no feee ptf entries for the patient, or
+4 ; -1 -- user decided to quit.
+5 IF '$DATA(^DGPT("AFEE",+$GET(DFN)))
QUIT 0
+6 ;IB*2.0*734
NEW ARR,PTF,IBD,IBQ,J,SEL,X,QF
SET IBQ=0
SET IBD=""
SET QF=""
+7 ;IB*2.0*734
FOR J=1:1
SET IBD=$ORDER(^DGPT("AFEE",DFN,IBD))
if 'IBD
QUIT
Begin DoDot:1
+8 ;IB*2.0*734
SET PTF=+$ORDER(^(IBD,0))
IF '$DATA(^DGPT(PTF,0))
QUIT
+9 ; ;IB*2.0*734
if J=1
WRITE !!," Please select one of the following Non-VA Care PTF entries:"
+10 ;IB*2.0*734
SET ARR(J)=PTF_"^"_(IBD\1)
WRITE !?3,J
DO DISEL
if '(J#5)
DO ASKAD
IF IBQ!($DATA(SEL))
SET QF=1
QUIT
End DoDot:1
+11 ;IB*2.0*734
IF '$DATA(ARR)
SET QF=1
+12 ;IB*2.0*734
IF QF'=1
Begin DoDot:1
+13 ;IB*2.0*734
IF '((J-1)#5)
WRITE !!?3,"End of list.",!
+14 ;IB*2.0*734
SET J=J-1
DO ASKAD
End DoDot:1
+15 ;IB*2.0*734
QUIT $SELECT('$DATA(ARR):0,IBQ!'$DATA(SEL):-1,1:SEL)
+16 ;
DISEL ; Display admission data.
+1 NEW DGPT
SET DGPT=$GET(^DGPT(PTF,0))
+2 WRITE ?7,$$DAT2^IBOUTL($PIECE(DGPT,"^",2))
+3 IF $GET(^DGPT(PTF,70))
WRITE ?32,"(Discharged: ",$$DAT2^IBOUTL(+^(70)),")"
+4 QUIT
+5 ;
ASKAD ; Prompt the user to select an admission.
+1 WRITE !," Select 1-",J," or type '^' to quit: "
READ X:DTIME
if '$TEST!(X["^")
SET IBQ=1
IF IBQ!(X="")
GOTO ASKADQ
+2 IF '$DATA(ARR(+X))
WRITE !!?3,*7,"Enter a NUMBER from 1-",J,".",!
GOTO ASKAD
+3 SET IBDIS=+$GET(^DGPT(+ARR(+X),70))\1
if 'IBDIS
SET IBDIS=DT
+4 IF IBFR'<$PIECE(ARR(+X),"^",2)
IF IBTO'>IBDIS
SET SEL=ARR(+X)
GOTO ASKADQ
+5 WRITE !!?3,*7,"The bill dates fall outside the admissions dates!",!
GOTO ASKAD
ASKADQ KILL IBDIS
+1 QUIT
+2 ;
+3 ;
ADEV ; Add a new event entry for the Non-VA PTF in file #350.
+1 ;IB*2.0*734
WRITE !!,"Building the Non-VA Care PTF event record... "
+2 NEW DIE,DR,DA
+3 DO EVADD^IBAUTL3
KILL IBN,IBEVDT
if IBY<0
QUIT
WRITE "done."
+4 SET DIE="^IB("
SET DA=IBEVDA
SET DR=".05////2"
DO ^DIE
+5 SET $PIECE(^IB(IBEVDA,0),"^",8)="FEE ADMISSION"
+6 QUIT
+7 ;
+8 ;
MED ; Is the Fee Charge for a CNH or Contract Hospital Admission?
+1 READ !," Is this a C(N)H or Contract (H)ospital Admission? CNH// ",X:DTIME
+2 IF '$TEST!(X["^")
SET IBY=-1
GOTO MEDQ
+3 if X=""
SET X="N"
SET X=$EXTRACT(X)
+4 IF "NHnh"'[X
DO HMED
GOTO MED
+5 WRITE $SELECT("nN"[X:" CNH",1:" CONTRACT HOSPITAL")
+6 SET IBADJMED=1
IF "Hh"[X
SET IBADJMED=2
SET IBMED=IBMED/2
MEDQ QUIT
+1 ;
HMED ; Help for the 'C(N)H or Contract (H)ospital' prompt
+1 WRITE !!?6,"Enter: '<CR>' - If the charge is for a CNH Admission"
+2 WRITE !?14,"'H' - If the charge is for a Contract Hospital Admission"
+3 WRITE !?14,"'^' - To quit this option",!
+4 QUIT
