IBOCNC2 ;ALB/ARH - CPT USAGE IN CLINICS (PRINT) ; 1/23/92
;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94
;
START ;set up headers and dates then do appropriate print
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 IBHDR="CLINIC CPT USAGE FOR "_IBBDTE_" - "_IBEDTE
S (IBPGN,IBLN)=0,IBDSH="" F IBI=1:1:IOM S IBDSH=IBDSH_"-"
D:IBSRT=0 PRINTC D:IBSRT=1 PRINTP D:IBSRT=2 PRINTD
K IBCDT,IBBDTE,IBEDTE,IBPGN,IBLN,IBI,IBDSH,IBHDR,Y
Q
;
PRINTC ;print the report from the temp sort file to the appropriate device, by clinic
S IBLBL="W !,?3,""CLINIC"",?36,""AMBULATORY PROCEDURE"",?75,"" COUNT"",?84,""OPC STATUS"",?114,"" CHARGE"",!" D HDR
S IBCLNN="" F S IBCLNN=$O(^TMP("IBCU",$J,IBCLNN)) Q:IBCLNN=""!(IBQ) D
. S IBCLN=$G(^TMP("IBCU",$J,IBCLNN,"N")),IBCP=1,IBCT=0
. S IBCPT=0 F S IBCPT=$O(^TMP("IBCU",$J,IBCLNN,IBCPT)) Q:IBCPT'?1N.N!(IBQ) D
.. S IBCPTP=$J($P($G(^ICPT(IBCPT,0)),"^",1),5)_" "_$P($G(^ICPT(IBCPT,0)),"^",2)
.. S (IBNA,IBHCFA)="" D CPT I (IBLN+1)>IOSL D HDR S IBCP=1
.. W !,?3,$S(IBCP:IBCLNN,1:""),?36,IBCPTP,?75,$J(^TMP("IBCU",$J,IBCLNN,IBCPT),6),?84,IBNA,?114,$J(IBHCFA,8)
.. S IBLN=IBLN+1,IBCT=IBCT+1,IBCP=0
. I 'IBQ D:(IBLN+2)>IOSL HDR W !,?36,$E(IBDSH,1,35),?76,$E(IBDSH,1,5),!,?36,"TOTAL: ",$J(IBCT,5),?75,$J(^TMP("IBCU",$J,IBCLNN),6),!
. S IBLN=IBLN+3
D:'IBQ PAUSE
K IBCLN,IBCLNN,IBCP,IBCT,IBCPT,IBCPTP,IBNA,IBHCFA,IBLBL,X,Y
Q
;
PRINTP ;print report from temp sort file by procedure
S IBLBL="W !,""AMBULATORY PROCEDURE"",?38,"" COUNT"",?46,""#BILLED"",?55,""OPC STATUS"",?85,"" CHARGE"",!" D HDR
S (IBCT,IBCPT)=0 F S IBCPT=$O(^TMP("IBCU",$J,IBCPT)) Q:IBCPT'?1N.N!(IBQ) D
. S IBCPTP=$J($P($G(^ICPT(IBCPT,0)),"^",1),5)_" "_$P($G(^ICPT(IBCPT,0)),"^",2)
. S (IBNA,IBHCFA)="" D CPT I (IBLN+1)>IOSL D HDR Q:IBQ
. W !,IBCPTP,?38,$J($G(^TMP("IBCU",$J,IBCPT)),6),?46,$J($G(^TMP("IBCU",$J,IBCPT,"B")),6),?55,IBNA,?85,$J(IBHCFA,8)
. S IBLN=IBLN+1,IBCT=IBCT+1
I 'IBQ,($D(^TMP("IBCU",$J))#2!$D(^TMP("IBCU",$J,"B"))#2) D:(IBLN+2)>IOSL HDR D
. W !,$E(IBDSH,1,34),?39,$E(IBDSH,1,5),?47,$E(IBDSH,1,5),!,"TOTAL: ",$J(IBCT,6),?38,$J(+$G(^TMP("IBCU",$J)),6),?46,$J(+$G(^TMP("IBCU",$J,"B")),6)
D:'IBQ PAUSE
K IBCPT,IBCPTP,IBNA,IBCT,IBHCFA,IBLBL,X,Y
Q
;
PRINTD ;print report from temp sort file by procedure with extended description
S IBLBL="W !,""AMBULATORY PROCEDURE"",?78,"" COUNT"",?86,""#BILLED"",?95,""OPC STATUS"",?124,"" CHARGE"",!" D HDR
S IBCPT=0 F S IBCPT=$O(^TMP("IBCU",$J,IBCPT)) Q:IBCPT'?1N.N!(IBQ) D
. S IBCPTP=$J($P($G(^ICPT(IBCPT,0)),"^",1),5)_" "_$P($G(^ICPT(IBCPT,0)),"^",2)
. S (IBNA,IBHCFA)="" D CPT,DESC I (IBLN+1)>IOSL D HDR Q:IBQ
. W !!,IBCPTP,?78,$J($G(^TMP("IBCU",$J,IBCPT)),6),?86,$J($G(^TMP("IBCU",$J,IBCPT,"B")),6),?95,IBNA,?124,$J(IBHCFA,8)
. S IBLN=IBLN+2 I $D(IBD) S IBX=0 F S IBX=$O(IBD(IBX)) Q:IBX=""!(IBQ) D
.. D:(IBLN+1)>IOSL HDR Q:IBQ W !,?7,IBD(IBX) S IBLN=IBLN+1
D:'IBQ PAUSE
K IBCPT,IBCPTP,IBNA,IBHCFA,IBLBL,IBD,IBX,X,Y
Q
;
CPT ;get CPT status and charge data
S D0=IBCPT S IBNA=$P(^DD(409.71,205,0),"^",5,999) X IBNA S IBNA=X
S X=$$CPTBSTAT^IBEFUNC1(IBCPT,DT),IBHCFA=$P(X,"^",2)
I +X S IBHCFA=$$CPTCHG^IBEFUNC1(IBCPT,$S($D(IBCLN):$P($G(^SC(+IBCLN,0)),"^",15),1:""),DT),IBHCFA=$J(IBHCFA,8,2)
K D0,X
Q
;
DESC ;if sort by proc & user wants desc, get procedure description, store in IBD at proper length for printing
Q:'$D(^ICPT(IBCPT,"D")) K IBD S IBY=1,IBX=0,IBLNG=68
F S IBX=$O(^ICPT(IBCPT,"D",IBX)) Q:IBX'?1N.N S IBZ=$G(^ICPT(IBCPT,"D",IBX,0)) D
. F IBJ=1:1 S IBW=$P(IBZ," ",IBJ) Q:IBW="" D
.. I $L(IBW)>IBLNG S:$G(IBD(IBY))'="" IBY=IBY+1 S IBD(IBY)=$E(IBW,1,IBLNG-1)_"-",IBY=IBY+1,IBD(IBY)=$E(IBW,IBLNG,999)_" " Q
.. I ($L($G(IBD(IBY)))+$L(IBW)+1)'>IBLNG S IBD(IBY)=$G(IBD(IBY))_IBW_" " Q
.. S IBY=IBY+1,IBD(IBY)=IBW_" "
K IBY,IBX,IBLNG,IBZ,IBJ,IBW
Q
;
HDR ;print the report header
S IBQ=$$STOP^IBOCNC1 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 I IOM<85 W !
W ?(IOM-30),IBCDT,?(IOM-8),"PAGE ",IBPGN,!
I $D(IBPRC) S IBI="" F S IBI=$O(IBPRC(IBI)) Q:IBI="" W !,IBPRC(IBI) S IBLN=IBLN+1
X IBLBL F IBI=1:1:IOM W "-"
K IBI
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
IBOCNC2 ;ALB/ARH - CPT USAGE IN CLINICS (PRINT) ; 1/23/92
+1 ;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94
+2 ;
START ;set up headers and dates then do appropriate print
+1 DO NOW^%DTC
SET Y=$EXTRACT(%,1,12)
DO DD^%DT
SET IBCDT=$PIECE(Y,"@",1)_" "_$PIECE(Y,"@",2)
+2 SET Y=IBBDT
XECUTE ^DD("DD")
SET IBBDTE=Y
SET Y=IBEDT
XECUTE ^DD("DD")
SET IBEDTE=Y
+3 SET IBHDR="CLINIC CPT USAGE FOR "_IBBDTE_" - "_IBEDTE
+4 SET (IBPGN,IBLN)=0
SET IBDSH=""
FOR IBI=1:1:IOM
SET IBDSH=IBDSH_"-"
+5 IF IBSRT=0
DO PRINTC
IF IBSRT=1
DO PRINTP
IF IBSRT=2
DO PRINTD
+6 KILL IBCDT,IBBDTE,IBEDTE,IBPGN,IBLN,IBI,IBDSH,IBHDR,Y
+7 QUIT
+8 ;
PRINTC ;print the report from the temp sort file to the appropriate device, by clinic
+1 SET IBLBL="W !,?3,""CLINIC"",?36,""AMBULATORY PROCEDURE"",?75,"" COUNT"",?84,""OPC STATUS"",?114,"" CHARGE"",!"
DO HDR
+2 SET IBCLNN=""
FOR
SET IBCLNN=$ORDER(^TMP("IBCU",$JOB,IBCLNN))
IF IBCLNN=""!(IBQ)
QUIT
Begin DoDot:1
+3 SET IBCLN=$GET(^TMP("IBCU",$JOB,IBCLNN,"N"))
SET IBCP=1
SET IBCT=0
+4 SET IBCPT=0
FOR
SET IBCPT=$ORDER(^TMP("IBCU",$JOB,IBCLNN,IBCPT))
IF IBCPT'?1N.N!(IBQ)
QUIT
Begin DoDot:2
+5 SET IBCPTP=$JUSTIFY($PIECE($GET(^ICPT(IBCPT,0)),"^",1),5)_" "_$PIECE($GET(^ICPT(IBCPT,0)),"^",2)
+6 SET (IBNA,IBHCFA)=""
DO CPT
IF (IBLN+1)>IOSL
DO HDR
SET IBCP=1
+7 WRITE !,?3,$SELECT(IBCP:IBCLNN,1:""),?36,IBCPTP,?75,$JUSTIFY(^TMP("IBCU",$JOB,IBCLNN,IBCPT),6),?84,IBNA,?114,$JUSTIFY(IBHCFA,8)
+8 SET IBLN=IBLN+1
SET IBCT=IBCT+1
SET IBCP=0
End DoDot:2
+9 IF 'IBQ
IF (IBLN+2)>IOSL
DO HDR
WRITE !,?36,$EXTRACT(IBDSH,1,35),?76,$EXTRACT(IBDSH,1,5),!,?36,"TOTAL: ",$JUSTIFY(IBCT,5),?75,$JUSTIFY(^TMP("IBCU",$JOB,IBCLNN),6),!
+10 SET IBLN=IBLN+3
End DoDot:1
+11 IF 'IBQ
DO PAUSE
+12 KILL IBCLN,IBCLNN,IBCP,IBCT,IBCPT,IBCPTP,IBNA,IBHCFA,IBLBL,X,Y
+13 QUIT
+14 ;
PRINTP ;print report from temp sort file by procedure
+1 SET IBLBL="W !,""AMBULATORY PROCEDURE"",?38,"" COUNT"",?46,""#BILLED"",?55,""OPC STATUS"",?85,"" CHARGE"",!"
DO HDR
+2 SET (IBCT,IBCPT)=0
FOR
SET IBCPT=$ORDER(^TMP("IBCU",$JOB,IBCPT))
IF IBCPT'?1N.N!(IBQ)
QUIT
Begin DoDot:1
+3 SET IBCPTP=$JUSTIFY($PIECE($GET(^ICPT(IBCPT,0)),"^",1),5)_" "_$PIECE($GET(^ICPT(IBCPT,0)),"^",2)
+4 SET (IBNA,IBHCFA)=""
DO CPT
IF (IBLN+1)>IOSL
DO HDR
IF IBQ
QUIT
+5 WRITE !,IBCPTP,?38,$JUSTIFY($GET(^TMP("IBCU",$JOB,IBCPT)),6),?46,$JUSTIFY($GET(^TMP("IBCU",$JOB,IBCPT,"B")),6),?55,IBNA,?85,$JUSTIFY(IBHCFA,8)
+6 SET IBLN=IBLN+1
SET IBCT=IBCT+1
End DoDot:1
+7 IF 'IBQ
IF ($DATA(^TMP("IBCU",$JOB))#2!$DATA(^TMP("IBCU",$JOB,"B"))#2)
IF (IBLN+2)>IOSL
DO HDR
Begin DoDot:1
+8 WRITE !,$EXTRACT(IBDSH,1,34),?39,$EXTRACT(IBDSH,1,5),?47,$EXTRACT(IBDSH,1,5),!,"TOTAL: ",$JUSTIFY(IBCT,6),?38,$JUSTIFY(+$GET(^TMP("IBCU",$JOB)),6),?46,$JUSTIFY(+$GET(^TMP("IBCU",$JOB,"B")),6)
End DoDot:1
+9 IF 'IBQ
DO PAUSE
+10 KILL IBCPT,IBCPTP,IBNA,IBCT,IBHCFA,IBLBL,X,Y
+11 QUIT
+12 ;
PRINTD ;print report from temp sort file by procedure with extended description
+1 SET IBLBL="W !,""AMBULATORY PROCEDURE"",?78,"" COUNT"",?86,""#BILLED"",?95,""OPC STATUS"",?124,"" CHARGE"",!"
DO HDR
+2 SET IBCPT=0
FOR
SET IBCPT=$ORDER(^TMP("IBCU",$JOB,IBCPT))
IF IBCPT'?1N.N!(IBQ)
QUIT
Begin DoDot:1
+3 SET IBCPTP=$JUSTIFY($PIECE($GET(^ICPT(IBCPT,0)),"^",1),5)_" "_$PIECE($GET(^ICPT(IBCPT,0)),"^",2)
+4 SET (IBNA,IBHCFA)=""
DO CPT
DO DESC
IF (IBLN+1)>IOSL
DO HDR
IF IBQ
QUIT
+5 WRITE !!,IBCPTP,?78,$JUSTIFY($GET(^TMP("IBCU",$JOB,IBCPT)),6),?86,$JUSTIFY($GET(^TMP("IBCU",$JOB,IBCPT,"B")),6),?95,IBNA,?124,$JUSTIFY(IBHCFA,8)
+6 SET IBLN=IBLN+2
IF $DATA(IBD)
SET IBX=0
FOR
SET IBX=$ORDER(IBD(IBX))
IF IBX=""!(IBQ)
QUIT
Begin DoDot:2
+7 IF (IBLN+1)>IOSL
DO HDR
IF IBQ
QUIT
WRITE !,?7,IBD(IBX)
SET IBLN=IBLN+1
End DoDot:2
End DoDot:1
+8 IF 'IBQ
DO PAUSE
+9 KILL IBCPT,IBCPTP,IBNA,IBHCFA,IBLBL,IBD,IBX,X,Y
+10 QUIT
+11 ;
CPT ;get CPT status and charge data
+1 SET D0=IBCPT
SET IBNA=$PIECE(^DD(409.71,205,0),"^",5,999)
XECUTE IBNA
SET IBNA=X
+2 SET X=$$CPTBSTAT^IBEFUNC1(IBCPT,DT)
SET IBHCFA=$PIECE(X,"^",2)
+3 IF +X
SET IBHCFA=$$CPTCHG^IBEFUNC1(IBCPT,$SELECT($DATA(IBCLN):$PIECE($GET(^SC(+IBCLN,0)),"^",15),1:""),DT)
SET IBHCFA=$JUSTIFY(IBHCFA,8,2)
+4 KILL D0,X
+5 QUIT
+6 ;
DESC ;if sort by proc & user wants desc, get procedure description, store in IBD at proper length for printing
+1 IF '$DATA(^ICPT(IBCPT,"D"))
QUIT
KILL IBD
SET IBY=1
SET IBX=0
SET IBLNG=68
+2 FOR
SET IBX=$ORDER(^ICPT(IBCPT,"D",IBX))
IF IBX'?1N.N
QUIT
SET IBZ=$GET(^ICPT(IBCPT,"D",IBX,0))
Begin DoDot:1
+3 FOR IBJ=1:1
SET IBW=$PIECE(IBZ," ",IBJ)
IF IBW=""
QUIT
Begin DoDot:2
+4 IF $LENGTH(IBW)>IBLNG
IF $GET(IBD(IBY))'=""
SET IBY=IBY+1
SET IBD(IBY)=$EXTRACT(IBW,1,IBLNG-1)_"-"
SET IBY=IBY+1
SET IBD(IBY)=$EXTRACT(IBW,IBLNG,999)_" "
QUIT
+5 IF ($LENGTH($GET(IBD(IBY)))+$LENGTH(IBW)+1)'>IBLNG
SET IBD(IBY)=$GET(IBD(IBY))_IBW_" "
QUIT
+6 SET IBY=IBY+1
SET IBD(IBY)=IBW_" "
End DoDot:2
End DoDot:1
+7 KILL IBY,IBX,IBLNG,IBZ,IBJ,IBW
+8 QUIT
+9 ;
HDR ;print the report header
+1 SET IBQ=$$STOP^IBOCNC1
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
IF IOM<85
WRITE !
+3 WRITE ?(IOM-30),IBCDT,?(IOM-8),"PAGE ",IBPGN,!
+4 IF $DATA(IBPRC)
SET IBI=""
FOR
SET IBI=$ORDER(IBPRC(IBI))
IF IBI=""
QUIT
WRITE !,IBPRC(IBI)
SET IBLN=IBLN+1
+5 XECUTE IBLBL
FOR IBI=1:1:IOM
WRITE "-"
+6 KILL IBI
+7 QUIT
+8 ;
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
