- 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 Mar 13, 2025@21:31:24 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)