IBOVOP1 ;ALB/RLW-Report of Visits for NSC Outpatients ;12-JUN-92
;;2.0;INTEGRATED BILLING;**52,91,99,132,156,176,234,249,339,372**;21-MAR-94;Build 12
;;Per VHA Directive 2004-038, this routine should not be modified.
;
MAIN(IBQUERY) ; perform report for day(s)
; IBQUERY = the query object to use to search for outpt encounters
; if not a valid #, a new QUERY will be created
D HDR^IBOVOP2
I $$STOP^IBOUTL("Outpatient/Registration Events Report") S IBQUIT=1 G END
; scan visits for NSC patients
N IBVAL,IBCBK,IBCK,IBFILTER,IBPB,IBOE,IBOE0,IBZ
S IBVAL("BDT")=IBDATE,IBVAL("EDT")=IBDATE\1+.99
S IBFILTER=""
; Look for hospital location is a clinic-type, valid Means-Test or LTC patient, and potentially billable events
S IBCBK="I $D(^SC(""AC"",""C"",+$P(Y0,U,4))) D IBCBK^IBOVOP1(Y,Y0,.IBCK)" ; Action of scanning
F IBZ=9,13.1 S IBCK(IBZ)=""
D SCAN^IBSDU("DATE/TIME",.IBVAL,"",IBCBK,0,.IBQUERY) K ^TMP("DIERR",$J)
; Search for Inpatient Observations
D IBOVOP^IBECEAU5(IBDATE)
D PRINT^IBOVOP2
END K DFN,^TMP("IBOVOP",$J),IBAPPT,IBJ,IB
Q
;
; To be executed only if the hospital location a clinic-type.
; Check the record, and add to the ^TMP if needed
; IBENC - encounter IEN
; IBENCZ - encounter zero-node
; IBCK - array of criteria flags for the $$BILLCK^IBAMTEDU() API call
IBCBK(IBENC,IBENCZ,IBCK) ;
N IBPAT,IBDAT,Y,Y0,X
; Quit if not a billable event
I '$$BILLCK^IBAMTEDU(IBENC,IBENCZ,.IBCK) Q
S IBDAT=+IBENCZ ; Date of event
S IBPAT=+$P(IBENCZ,U,2) Q:'IBPAT ; Patient IEN
; Check for valid MT or LTC patient
I '$$BIL^DGMTUB(IBPAT,IBDAT),+$$LTCST^IBAECU(IBPAT,IBDAT,1)'=2 Q
D OPTENC(IBENC,IBENCZ) ; Extract Outpatient Encounter and add to the ^TMP global
Q
;
;
OPTENC(IBOE,IBOE0) ; Extract outpatient encounter
N IBCL,DFN,IBFLD4,IBJ,IBSEQ
S DFN=+$P(IBOE0,U,2),IBJ=+IBOE0,IBCL=+$P(IBOE0,U,4),IBSEQ=0
Q:'$$BIL^DGMTUB(DFN,IBJ)
I $P(IBOE0,U,8)=1 D ; - appt
.; field 4=clinic
.; field 5=appt type
.; field 6=status
. S IBFLD4=$P($G(^SC(IBCL,0)),U)
. I IBFLD4'="" S:+$G(^SC(IBCL,"AT"))=6 IBFLD4=$E(IBFLD4,1,13)_" [R]"
. S ^TMP("IBOVOP",$J,$$FLD1(DFN),"CLINIC APPT",$$FLD3(IBJ,1),0)=$E(IBFLD4,1,17)_U_$$FLD5($P(IBOE0,U,10))_U_$E($$EXTERNAL^DILFD(409.68,.12,"",$P(IBOE0,"^",12)),1,17)_U_DFN_U_IBOE Q
;
I $P(IBOE0,U,8)=2 D ; - add/edit stop code
.; field 5=appt type
. S ^TMP("IBOVOP",$J,$$FLD1(DFN),"STOP CODE",$$FLD3(IBJ,1),IBSEQ)=$E($P($G(^DIC(40.7,$P(IBOE0,U,3),0)),U),1,16)_U_$$FLD5($P(IBOE0,U,10))_"^^"_DFN_U_IBOE,IBSEQ=IBSEQ+1
;
I $P(IBOE0,U,8)=3 D ; - registration
. Q:'$$DISCT^IBEFUNC(IBOE,IBOE0)
. S IBDATA=$$DISND^IBSDU(IBOE,IBOE0)
. S IBFLD4=$E($$EXTERNAL^DILFD(2.101,2,"",$P(IBDATA,U,3)),1,16)
. S Y=$E($$EXTERNAL^DILFD(2.101,6,"",$P(IBDATA,U,7)),1,30)
. S ^TMP("IBOVOP",$J,$$FLD1(DFN),"REGISTRATION",$$FLD3(IBJ,1),0)=IBFLD4_U_Y_"^^"_DFN_U_IBOE
;
K IBB,IBE,IBX,IBY,IBCLN,IBXP,IBDFN,IBAPDT,IBAPTYP,X,Y
Q
CKENC(IBOE,IBOE0,IBSEQ) ;
S DFN=$P(IBOE0,U,2),IBJ=+IBOE0
Q
;
FLD1(DFN) ; get patient name, l-4 ssn id, classification, insured?
I '$G(DFN) Q ""
N IBX,IBY,IBZ S IBX=$$PT^IBEFUNC(DFN),IBZ=""
D CL^IBACV(DFN,IBDATE,"",.IBY)
I $D(IBY(1)) S IBZ="AO"
I $D(IBY(2)) S IBZ=IBZ_$S(IBZ]"":"/",1:"")_"IR"
I $D(IBY(3)) S IBZ=IBZ_$S(IBZ]"":"/",1:"")_"SC"
I $D(IBY(4)) S IBZ=IBZ_$S(IBZ]"":"/",1:"")_"SWA"
I $D(IBY(5)) S IBZ=IBZ_$S(IBZ]"":"/",1:"")_"MST"
I $D(IBY(6)) S IBZ=IBZ_$S(IBZ]"":"/",1:"")_"HNC"
I $D(IBY(7)) S IBZ=IBZ_$S(IBZ]"":"/",1:"")_"CV"
I $D(IBY(8)) S IBZ=IBZ_$S(IBZ]"":"/",1:"")_"SHAD"
Q $E($P(IBX,U),1,20)_" "_$E(IBX)_$P(IBX,U,3)_$S(IBZ]"":" ["_IBZ_"]",1:"")_$S($$INSURED^IBCNS1(DFN,IBDATE):" **Insured**",1:"")
;
FLD3(Y,IBMID) ; time - convert date/time to time only, no seconds
I +$G(IBMID) Q:$G(Y)'["." "00.00"
I '$G(Y) Q ""
X ^DD("DD") Q $P($P(Y,"@",2),":",1,2)
;
FLD5(I) ; get appointment type name
Q $E($P($G(^SD(409.1,+$G(I),0)),U,1),1,17)
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBOVOP1 3989 printed Dec 13, 2024@02:26:23 Page 2
IBOVOP1 ;ALB/RLW-Report of Visits for NSC Outpatients ;12-JUN-92
+1 ;;2.0;INTEGRATED BILLING;**52,91,99,132,156,176,234,249,339,372**;21-MAR-94;Build 12
+2 ;;Per VHA Directive 2004-038, this routine should not be modified.
+3 ;
MAIN(IBQUERY) ; perform report for day(s)
+1 ; IBQUERY = the query object to use to search for outpt encounters
+2 ; if not a valid #, a new QUERY will be created
+3 DO HDR^IBOVOP2
+4 IF $$STOP^IBOUTL("Outpatient/Registration Events Report")
SET IBQUIT=1
GOTO END
+5 ; scan visits for NSC patients
+6 NEW IBVAL,IBCBK,IBCK,IBFILTER,IBPB,IBOE,IBOE0,IBZ
+7 SET IBVAL("BDT")=IBDATE
SET IBVAL("EDT")=IBDATE\1+.99
+8 SET IBFILTER=""
+9 ; Look for hospital location is a clinic-type, valid Means-Test or LTC patient, and potentially billable events
+10 ; Action of scanning
SET IBCBK="I $D(^SC(""AC"",""C"",+$P(Y0,U,4))) D IBCBK^IBOVOP1(Y,Y0,.IBCK)"
+11 FOR IBZ=9,13.1
SET IBCK(IBZ)=""
+12 DO SCAN^IBSDU("DATE/TIME",.IBVAL,"",IBCBK,0,.IBQUERY)
KILL ^TMP("DIERR",$JOB)
+13 ; Search for Inpatient Observations
+14 DO IBOVOP^IBECEAU5(IBDATE)
+15 DO PRINT^IBOVOP2
END KILL DFN,^TMP("IBOVOP",$JOB),IBAPPT,IBJ,IB
+1 QUIT
+2 ;
+3 ; To be executed only if the hospital location a clinic-type.
+4 ; Check the record, and add to the ^TMP if needed
+5 ; IBENC - encounter IEN
+6 ; IBENCZ - encounter zero-node
+7 ; IBCK - array of criteria flags for the $$BILLCK^IBAMTEDU() API call
IBCBK(IBENC,IBENCZ,IBCK) ;
+1 NEW IBPAT,IBDAT,Y,Y0,X
+2 ; Quit if not a billable event
+3 IF '$$BILLCK^IBAMTEDU(IBENC,IBENCZ,.IBCK)
QUIT
+4 ; Date of event
SET IBDAT=+IBENCZ
+5 ; Patient IEN
SET IBPAT=+$PIECE(IBENCZ,U,2)
if 'IBPAT
QUIT
+6 ; Check for valid MT or LTC patient
+7 IF '$$BIL^DGMTUB(IBPAT,IBDAT)
IF +$$LTCST^IBAECU(IBPAT,IBDAT,1)'=2
QUIT
+8 ; Extract Outpatient Encounter and add to the ^TMP global
DO OPTENC(IBENC,IBENCZ)
+9 QUIT
+10 ;
+11 ;
OPTENC(IBOE,IBOE0) ; Extract outpatient encounter
+1 NEW IBCL,DFN,IBFLD4,IBJ,IBSEQ
+2 SET DFN=+$PIECE(IBOE0,U,2)
SET IBJ=+IBOE0
SET IBCL=+$PIECE(IBOE0,U,4)
SET IBSEQ=0
+3 if '$$BIL^DGMTUB(DFN,IBJ)
QUIT
+4 ; - appt
IF $PIECE(IBOE0,U,8)=1
Begin DoDot:1
+5 ; field 4=clinic
+6 ; field 5=appt type
+7 ; field 6=status
+8 SET IBFLD4=$PIECE($GET(^SC(IBCL,0)),U)
+9 IF IBFLD4'=""
if +$GET(^SC(IBCL,"AT"))=6
SET IBFLD4=$EXTRACT(IBFLD4,1,13)_" [R]"
+10 SET ^TMP("IBOVOP",$JOB,$$FLD1(DFN),"CLINIC APPT",$$FLD3(IBJ,1),0)=$EXTRACT(IBFLD4,1,17)_U_$$FLD5($PIECE(IBOE0,U,10))_U_$EXTRACT($$EXTERNAL^DILFD(409.68,.12,"",$PIECE(IBOE0,"^",12)),1,17)_U_DFN_U_IBOE
QUIT
End DoDot:1
+11 ;
+12 ; - add/edit stop code
IF $PIECE(IBOE0,U,8)=2
Begin DoDot:1
+13 ; field 5=appt type
+14 SET ^TMP("IBOVOP",$JOB,$$FLD1(DFN),"STOP CODE",$$FLD3(IBJ,1),IBSEQ)=$EXTRACT($PIECE($GET(^DIC(40.7,$PIECE(IBOE0,U,3),0)),U),1,16)_U_$$FLD5($PIECE(IBOE0,U,10))_"^^"_DFN_U_IBOE
SET IBSEQ=IBSEQ+1
End DoDot:1
+15 ;
+16 ; - registration
IF $PIECE(IBOE0,U,8)=3
Begin DoDot:1
+17 if '$$DISCT^IBEFUNC(IBOE,IBOE0)
QUIT
+18 SET IBDATA=$$DISND^IBSDU(IBOE,IBOE0)
+19 SET IBFLD4=$EXTRACT($$EXTERNAL^DILFD(2.101,2,"",$PIECE(IBDATA,U,3)),1,16)
+20 SET Y=$EXTRACT($$EXTERNAL^DILFD(2.101,6,"",$PIECE(IBDATA,U,7)),1,30)
+21 SET ^TMP("IBOVOP",$JOB,$$FLD1(DFN),"REGISTRATION",$$FLD3(IBJ,1),0)=IBFLD4_U_Y_"^^"_DFN_U_IBOE
End DoDot:1
+22 ;
+23 KILL IBB,IBE,IBX,IBY,IBCLN,IBXP,IBDFN,IBAPDT,IBAPTYP,X,Y
+24 QUIT
CKENC(IBOE,IBOE0,IBSEQ) ;
+1 SET DFN=$PIECE(IBOE0,U,2)
SET IBJ=+IBOE0
+2 QUIT
+3 ;
FLD1(DFN) ; get patient name, l-4 ssn id, classification, insured?
+1 IF '$GET(DFN)
QUIT ""
+2 NEW IBX,IBY,IBZ
SET IBX=$$PT^IBEFUNC(DFN)
SET IBZ=""
+3 DO CL^IBACV(DFN,IBDATE,"",.IBY)
+4 IF $DATA(IBY(1))
SET IBZ="AO"
+5 IF $DATA(IBY(2))
SET IBZ=IBZ_$SELECT(IBZ]"":"/",1:"")_"IR"
+6 IF $DATA(IBY(3))
SET IBZ=IBZ_$SELECT(IBZ]"":"/",1:"")_"SC"
+7 IF $DATA(IBY(4))
SET IBZ=IBZ_$SELECT(IBZ]"":"/",1:"")_"SWA"
+8 IF $DATA(IBY(5))
SET IBZ=IBZ_$SELECT(IBZ]"":"/",1:"")_"MST"
+9 IF $DATA(IBY(6))
SET IBZ=IBZ_$SELECT(IBZ]"":"/",1:"")_"HNC"
+10 IF $DATA(IBY(7))
SET IBZ=IBZ_$SELECT(IBZ]"":"/",1:"")_"CV"
+11 IF $DATA(IBY(8))
SET IBZ=IBZ_$SELECT(IBZ]"":"/",1:"")_"SHAD"
+12 QUIT $EXTRACT($PIECE(IBX,U),1,20)_" "_$EXTRACT(IBX)_$PIECE(IBX,U,3)_$SELECT(IBZ]"":" ["_IBZ_"]",1:"")_$SELECT($$INSURED^IBCNS1(DFN,IBDATE):" **Insured**",1:"")
+13 ;
FLD3(Y,IBMID) ; time - convert date/time to time only, no seconds
+1 IF +$GET(IBMID)
if $GET(Y)'["."
QUIT "00.00"
+2 IF '$GET(Y)
QUIT ""
+3 XECUTE ^DD("DD")
QUIT $PIECE($PIECE(Y,"@",2),":",1,2)
+4 ;
FLD5(I) ; get appointment type name
+1 QUIT $EXTRACT($PIECE($GET(^SD(409.1,+$GET(I),0)),U,1),1,17)
