- IBOVOP2 ;ALB/CPM - Opt/Reg Events Report Print Utilities ; 30-AUG-93
- ;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94
- ;
- PRINT ; Retrieve data for printing.
- S IBFLD1="" I '$D(^TMP("IBOVOP",$J)) W !!,"No Outpatient activity recorded for Category C patients on ",$$DAT1^IBOUTL(IBDATE),"."
- F S IBFLD1=$O(^TMP("IBOVOP",$J,IBFLD1)) Q:(IBFLD1="")!(IBQUIT) W ! D:IBLINE>55 HDR W !,IBFLD1 D D CHRGS Q:IBQUIT
- .S IBFLD2="" F S IBFLD2=$O(^TMP("IBOVOP",$J,IBFLD1,IBFLD2)) Q:(IBFLD2="")!(IBQUIT) W !?5,IBFLD2 D
- ..S IBFLD3="" F S IBFLD3=$O(^TMP("IBOVOP",$J,IBFLD1,IBFLD2,IBFLD3)) Q:(IBFLD3="")!(IBQUIT) D
- ...S IBSEQ="" F S IBSEQ=$O(^TMP("IBOVOP",$J,IBFLD1,IBFLD2,IBFLD3,IBSEQ)) Q:(IBSEQ="")!(IBQUIT) S IBDATA=$G(^(IBSEQ)) D
- ....S IBFLD4=$P(IBDATA,"^",1),IBFLD5=$P(IBDATA,"^",2),IBFLD6=$P(IBDATA,"^",3),DFN=$P(IBDATA,"^",4)
- ....W ?20,IBFLD3,?26,IBFLD4,?44,IBFLD5,?63,IBFLD6 D CLSF(+$P(IBDATA,"^",5)) W ! S IBLINE=IBLINE+1
- ....I IBLINE>55 D HDR W !,IBFLD1 I $D(^TMP("IBOVOP",$J,IBFLD1,IBFLD2,IBFLD3,IBSEQ+1)) W !?5,IBFLD2
- ....I $Y>(IOSL-5) D PAUSE^IBOUTL Q:IBQUIT D HDR W !,IBFLD1,!?5,IBFLD2
- D:'IBQUIT PAUSE^IBOUTL
- Q
- ;
- CHRGS ; Find OP charges for day, if any. Build string for print.
- Q:'$G(DFN)
- I $D(^IB("AFDT",DFN,-IBDATE))=10 D
- .S IBPRNT="" F S IBPRNT=$O(^IB("AFDT",DFN,-IBDATE,IBPRNT)) Q:IBPRNT=""!(IBQUIT) D
- ..S IBIEN="" F S IBIEN=$O(^IB("AD",IBPRNT,IBIEN)) Q:IBIEN=""!(IBQUIT) D
- ...S IBDATA=$G(^IB(IBIEN,0)) Q:IBDATA=""
- ...I $Y>(IOSL-5) D PAUSE^IBOUTL Q:IBQUIT D HDR W !,IBFLD1
- ...S IBSTAT=$P($G(^IBE(350.21,+$P(IBDATA,"^",5),0)),"^",2)
- ...S IBACT=$S($P($G(^IBE(350.1,+$P(IBDATA,"^",3),0)),"^",8)'="":$P(^(0),"^",8),1:$P(^(0),"^",1))
- ...S IBAMT=$P(IBDATA,"^",7),IBAMT=$S(IBACT["CANCEL":"*($"_IBAMT_")",1:"* $"_IBAMT)
- ...W !?5,IBAMT,?13,IBACT,?63,IBSTAT S IBLINE=IBLINE+1
- Q
- ;
- HDR ; Print header.
- S IBPAGE=IBPAGE+1,IBLINE=5,IBTITLE="Category C Outpatient and Registration Activity for "_$$DAT1^IBOUTL(IBDATE)
- I $E(IOST,1,2)["C-"!(IBPAGE>1) W @IOF,*13
- W ?(80-$L(IBTITLE))\2,IBTITLE
- S IBTITLE="Printed: "_$$DAT1^IBOUTL(DT)
- W !?(80-$L(IBTITLE))\2,IBTITLE,?70,"Page: "_IBPAGE
- W !!,"Patient/Event",?20,"Time",?26,"Clinic/Stop",?44,"Appt.Type",?63,"(Status)",!
- Q
- ;
- CLSF(IBOE) ; Display classification results.
- ; Input: IBOE -- Pointer to Outpatient Encounter in file #409.68
- I '$G(IBOE) G CLSFQ
- N I,IBCLS,IBCLSD,IBF S IBF=0,IBCLSD=$$ENCL^IBAMTS2(IBOE)
- I IBCLSD]"" F I=1,2,4 S IBCLS=$P(IBCLSD,"^",I) I IBCLS]"" W:'IBF !?6 W:IBF " " W "Care related to ",$S(I=1:"AO",I=2:"IR",1:"EC"),"? ",$S(IBCLS:"YES",1:"NO") S IBF=1
- CLSFQ Q
- IBOVOP2 ;ALB/CPM - Opt/Reg Events Report Print Utilities ; 30-AUG-93
- +1 ;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94
- +2 ;
- PRINT ; Retrieve data for printing.
- +1 SET IBFLD1=""
- IF '$DATA(^TMP("IBOVOP",$JOB))
- WRITE !!,"No Outpatient activity recorded for Category C patients on ",$$DAT1^IBOUTL(IBDATE),"."
- +2 FOR
- SET IBFLD1=$ORDER(^TMP("IBOVOP",$JOB,IBFLD1))
- IF (IBFLD1="")!(IBQUIT)
- QUIT
- WRITE !
- IF IBLINE>55
- DO HDR
- WRITE !,IBFLD1
- Begin DoDot:1
- +3 SET IBFLD2=""
- FOR
- SET IBFLD2=$ORDER(^TMP("IBOVOP",$JOB,IBFLD1,IBFLD2))
- IF (IBFLD2="")!(IBQUIT)
- QUIT
- WRITE !?5,IBFLD2
- Begin DoDot:2
- +4 SET IBFLD3=""
- FOR
- SET IBFLD3=$ORDER(^TMP("IBOVOP",$JOB,IBFLD1,IBFLD2,IBFLD3))
- IF (IBFLD3="")!(IBQUIT)
- QUIT
- Begin DoDot:3
- +5 SET IBSEQ=""
- FOR
- SET IBSEQ=$ORDER(^TMP("IBOVOP",$JOB,IBFLD1,IBFLD2,IBFLD3,IBSEQ))
- IF (IBSEQ="")!(IBQUIT)
- QUIT
- SET IBDATA=$GET(^(IBSEQ))
- Begin DoDot:4
- +6 SET IBFLD4=$PIECE(IBDATA,"^",1)
- SET IBFLD5=$PIECE(IBDATA,"^",2)
- SET IBFLD6=$PIECE(IBDATA,"^",3)
- SET DFN=$PIECE(IBDATA,"^",4)
- +7 WRITE ?20,IBFLD3,?26,IBFLD4,?44,IBFLD5,?63,IBFLD6
- DO CLSF(+$PIECE(IBDATA,"^",5))
- WRITE !
- SET IBLINE=IBLINE+1
- +8 IF IBLINE>55
- DO HDR
- WRITE !,IBFLD1
- IF $DATA(^TMP("IBOVOP",$JOB,IBFLD1,IBFLD2,IBFLD3,IBSEQ+1))
- WRITE !?5,IBFLD2
- +9 IF $Y>(IOSL-5)
- DO PAUSE^IBOUTL
- IF IBQUIT
- QUIT
- DO HDR
- WRITE !,IBFLD1,!?5,IBFLD2
- End DoDot:4
- End DoDot:3
- End DoDot:2
- End DoDot:1
- DO CHRGS
- IF IBQUIT
- QUIT
- +10 IF 'IBQUIT
- DO PAUSE^IBOUTL
- +11 QUIT
- +12 ;
- CHRGS ; Find OP charges for day, if any. Build string for print.
- +1 IF '$GET(DFN)
- QUIT
- +2 IF $DATA(^IB("AFDT",DFN,-IBDATE))=10
- Begin DoDot:1
- +3 SET IBPRNT=""
- FOR
- SET IBPRNT=$ORDER(^IB("AFDT",DFN,-IBDATE,IBPRNT))
- IF IBPRNT=""!(IBQUIT)
- QUIT
- Begin DoDot:2
- +4 SET IBIEN=""
- FOR
- SET IBIEN=$ORDER(^IB("AD",IBPRNT,IBIEN))
- IF IBIEN=""!(IBQUIT)
- QUIT
- Begin DoDot:3
- +5 SET IBDATA=$GET(^IB(IBIEN,0))
- IF IBDATA=""
- QUIT
- +6 IF $Y>(IOSL-5)
- DO PAUSE^IBOUTL
- IF IBQUIT
- QUIT
- DO HDR
- WRITE !,IBFLD1
- +7 SET IBSTAT=$PIECE($GET(^IBE(350.21,+$PIECE(IBDATA,"^",5),0)),"^",2)
- +8 SET IBACT=$SELECT($PIECE($GET(^IBE(350.1,+$PIECE(IBDATA,"^",3),0)),"^",8)'="":$PIECE(^(0),"^",8),1:$PIECE(^(0),"^",1))
- +9 SET IBAMT=$PIECE(IBDATA,"^",7)
- SET IBAMT=$SELECT(IBACT["CANCEL":"*($"_IBAMT_")",1:"* $"_IBAMT)
- +10 WRITE !?5,IBAMT,?13,IBACT,?63,IBSTAT
- SET IBLINE=IBLINE+1
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +11 QUIT
- +12 ;
- HDR ; Print header.
- +1 SET IBPAGE=IBPAGE+1
- SET IBLINE=5
- SET IBTITLE="Category C Outpatient and Registration Activity for "_$$DAT1^IBOUTL(IBDATE)
- +2 IF $EXTRACT(IOST,1,2)["C-"!(IBPAGE>1)
- WRITE @IOF,*13
- +3 WRITE ?(80-$LENGTH(IBTITLE))\2,IBTITLE
- +4 SET IBTITLE="Printed: "_$$DAT1^IBOUTL(DT)
- +5 WRITE !?(80-$LENGTH(IBTITLE))\2,IBTITLE,?70,"Page: "_IBPAGE
- +6 WRITE !!,"Patient/Event",?20,"Time",?26,"Clinic/Stop",?44,"Appt.Type",?63,"(Status)",!
- +7 QUIT
- +8 ;
- CLSF(IBOE) ; Display classification results.
- +1 ; Input: IBOE -- Pointer to Outpatient Encounter in file #409.68
- +2 IF '$GET(IBOE)
- GOTO CLSFQ
- +3 NEW I,IBCLS,IBCLSD,IBF
- SET IBF=0
- SET IBCLSD=$$ENCL^IBAMTS2(IBOE)
- +4 IF IBCLSD]""
- FOR I=1,2,4
- SET IBCLS=$PIECE(IBCLSD,"^",I)
- IF IBCLS]""
- IF 'IBF
- WRITE !?6
- IF IBF
- WRITE " "
- WRITE "Care related to ",$SELECT(I=1:"AO",I=2:"IR",1:"EC"),"? ",$SELECT(IBCLS:"YES",1:"NO")
- SET IBF=1
- CLSFQ QUIT
