- IBOBCC1 ;ALB/ARH - UNBILLED APPOINTMENT BASC FOR INSURED PATIENTS ; 2/27/92
- ;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94
- ;
- PRINT ;set up headers and dates then print
- G:IBQ END
- D NOW^%DTC S Y=$E(%,1,12) D DD^%DT S IBCDT=$P(Y,"@",1)_" "_$P(Y,"@",2)
- S Y=IBBDT X ^DD("DD") S IBBDTE=Y,Y=IBEDT X ^DD("DD") S IBEDTE=Y
- S (IBPGN,IBLN)=0,IBDSH="" F IBI=1:1:IOM S IBDSH=IBDSH_"-"
- D HDR,P1
- END K IBCDT,IBBDTE,IBEDTE,IBPGN,IBQ,IBLN,IBI,IBDSH,Y
- I $D(ZTQUEUED) S ZTREQ="@"
- ;I $D(XRT0) S:'$D(XRTN) XRTN="IBOBCC" D T1^%ZOSV ;stop rt clock
- Q
- ;
- P1 ;print the report from the temp sort file to the appropriate device
- I $D(^TMP("IBBC",$J)) S IBPNM="" F S IBPNM=$O(^TMP("IBBC",$J,"N",IBPNM)) Q:IBPNM=""!(IBQ) S IBDFN="" D
- . F S IBDFN=$O(^TMP("IBBC",$J,"N",IBPNM,IBDFN)) Q:IBDFN=""!(IBQ) W ! S IBLN=IBLN+1 D
- .. S IBPAT=$$PT^IBEFUNC(IBDFN) Q:IBPAT="" S IBAD="" F S IBAD=$O(^TMP("IBBC",$J,IBDFN,IBAD)) Q:IBAD=""!(IBQ) D
- ... D:(IBLN+2)>IOSL HDR S Y=IBAD X ^DD("DD") S IBADE=Y W ?3,$P(IBPAT,"^",1),?35,$P(IBPAT,"^",2),?52,IBADE S IBCPT=""
- ... F S IBCPT=$O(^TMP("IBBC",$J,IBDFN,IBAD,IBCPT)) Q:IBCPT=""!(IBQ) S IBN=^(IBCPT) F IBI=1:1:IBN D Q:IBQ
- .... I (IBLN+2)>IOSL D HDR W ?3,$P(IBPAT,"^",1),?35,$P(IBPAT,"^",2),?52,IBADE
- .... W ?68,$P($G(^ICPT(+IBCPT,0)),"^",1)," ",$P(^(0),"^",2),! S IBLN=IBLN+1
- D:'IBQ PAUSE
- K IBPNM,IBDFN,IBCPT,IBAD,IBADE,IBN,IBI,IBPAT,X,Y,^TMP("IBBC",$J)
- Q
- ;
- HDR ;print the report header, allow user stops, for terminals only form feed on first page
- S IBQ=$$STOP Q:IBQ D:IBPGN>0 PAUSE Q:IBQ I IBPGN>0!($E(IOST,1,2)["C-") W @IOF
- S IBPGN=IBPGN+1,IBLN=5 W IBHDR," FOR ",IBBDTE," - ",IBEDTE I IOM<85 W !
- W ?(IOM-30),IBCDT,?(IOM-8),"PAGE ",IBPGN,!
- W !,?3,"PATIENT NAME",?35,"PATIENT ID",?50,"APPOINTMENT DATE",?68,"BILLABLE AMBULATORY PROCEDURE",! W IBDSH,!
- Q
- ;
- PAUSE ;pause at end of screen if being displayed on a terminal
- Q:$E(IOST,1,2)'["C-"
- S DIR(0)="E" D ^DIR K DIR I $D(DUOUT)!($D(DIRUT)) S IBQ=1
- Q
- ;
- STOP() ;determine if user requested task to be stopped
- I $D(ZTQUEUED),$$S^%ZTLOAD S ZTSTOP=1 K ZTREQ I +$G(IBPGN) W !!,"TASK STOPPED BY USER",!!
- Q +$G(ZTSTOP)
- IBOBCC1 ;ALB/ARH - UNBILLED APPOINTMENT BASC FOR INSURED PATIENTS ; 2/27/92
- +1 ;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94
- +2 ;
- PRINT ;set up headers and dates then print
- +1 IF IBQ
- GOTO END
- +2 DO NOW^%DTC
- SET Y=$EXTRACT(%,1,12)
- DO DD^%DT
- SET IBCDT=$PIECE(Y,"@",1)_" "_$PIECE(Y,"@",2)
- +3 SET Y=IBBDT
- XECUTE ^DD("DD")
- SET IBBDTE=Y
- SET Y=IBEDT
- XECUTE ^DD("DD")
- SET IBEDTE=Y
- +4 SET (IBPGN,IBLN)=0
- SET IBDSH=""
- FOR IBI=1:1:IOM
- SET IBDSH=IBDSH_"-"
- +5 DO HDR
- DO P1
- END KILL IBCDT,IBBDTE,IBEDTE,IBPGN,IBQ,IBLN,IBI,IBDSH,Y
- +1 IF $DATA(ZTQUEUED)
- SET ZTREQ="@"
- +2 ;I $D(XRT0) S:'$D(XRTN) XRTN="IBOBCC" D T1^%ZOSV ;stop rt clock
- +3 QUIT
- +4 ;
- P1 ;print the report from the temp sort file to the appropriate device
- +1 IF $DATA(^TMP("IBBC",$JOB))
- SET IBPNM=""
- FOR
- SET IBPNM=$ORDER(^TMP("IBBC",$JOB,"N",IBPNM))
- IF IBPNM=""!(IBQ)
- QUIT
- SET IBDFN=""
- Begin DoDot:1
- +2 FOR
- SET IBDFN=$ORDER(^TMP("IBBC",$JOB,"N",IBPNM,IBDFN))
- IF IBDFN=""!(IBQ)
- QUIT
- WRITE !
- SET IBLN=IBLN+1
- Begin DoDot:2
- +3 SET IBPAT=$$PT^IBEFUNC(IBDFN)
- IF IBPAT=""
- QUIT
- SET IBAD=""
- FOR
- SET IBAD=$ORDER(^TMP("IBBC",$JOB,IBDFN,IBAD))
- IF IBAD=""!(IBQ)
- QUIT
- Begin DoDot:3
- +4 IF (IBLN+2)>IOSL
- DO HDR
- SET Y=IBAD
- XECUTE ^DD("DD")
- SET IBADE=Y
- WRITE ?3,$PIECE(IBPAT,"^",1),?35,$PIECE(IBPAT,"^",2),?52,IBADE
- SET IBCPT=""
- +5 FOR
- SET IBCPT=$ORDER(^TMP("IBBC",$JOB,IBDFN,IBAD,IBCPT))
- IF IBCPT=""!(IBQ)
- QUIT
- SET IBN=^(IBCPT)
- FOR IBI=1:1:IBN
- Begin DoDot:4
- +6 IF (IBLN+2)>IOSL
- DO HDR
- WRITE ?3,$PIECE(IBPAT,"^",1),?35,$PIECE(IBPAT,"^",2),?52,IBADE
- +7 WRITE ?68,$PIECE($GET(^ICPT(+IBCPT,0)),"^",1)," ",$PIECE(^(0),"^",2),!
- SET IBLN=IBLN+1
- End DoDot:4
- IF IBQ
- QUIT
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +8 IF 'IBQ
- DO PAUSE
- +9 KILL IBPNM,IBDFN,IBCPT,IBAD,IBADE,IBN,IBI,IBPAT,X,Y,^TMP("IBBC",$JOB)
- +10 QUIT
- +11 ;
- HDR ;print the report header, allow user stops, for terminals only form feed on first page
- +1 SET IBQ=$$STOP
- IF IBQ
- QUIT
- IF IBPGN>0
- DO PAUSE
- IF IBQ
- QUIT
- IF IBPGN>0!($EXTRACT(IOST,1,2)["C-")
- WRITE @IOF
- +2 SET IBPGN=IBPGN+1
- SET IBLN=5
- WRITE IBHDR," FOR ",IBBDTE," - ",IBEDTE
- IF IOM<85
- WRITE !
- +3 WRITE ?(IOM-30),IBCDT,?(IOM-8),"PAGE ",IBPGN,!
- +4 WRITE !,?3,"PATIENT NAME",?35,"PATIENT ID",?50,"APPOINTMENT DATE",?68,"BILLABLE AMBULATORY PROCEDURE",!
- WRITE IBDSH,!
- +5 QUIT
- +6 ;
- PAUSE ;pause at end of screen if being displayed on a terminal
- +1 IF $EXTRACT(IOST,1,2)'["C-"
- QUIT
- +2 SET DIR(0)="E"
- DO ^DIR
- KILL DIR
- IF $DATA(DUOUT)!($DATA(DIRUT))
- SET IBQ=1
- +3 QUIT
- +4 ;
- STOP() ;determine if user requested task to be stopped
- +1 IF $DATA(ZTQUEUED)
- IF $$S^%ZTLOAD
- SET ZTSTOP=1
- KILL ZTREQ
- IF +$GET(IBPGN)
- WRITE !!,"TASK STOPPED BY USER",!!
- +2 QUIT +$GET(ZTSTOP)