IBECEA34.m

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 ---IBECEA34   3236     printed  Feb 18, 2025@23:47:43                                                                                                                                                                                                    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