IBOVOP1 ;ALB/RLW - Report of Visits for NSC Outpatients ; 12-JUN-92
;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94
MAIN ; perform report for day(s)
D HDR^IBOVOP2
I $$STOP^IBOUTL("Outpatient/Registration Events Report") S IBQUIT=1 G END
D APPT,STOPCD,REGS,PRINT^IBOVOP2
END K DFN,^TMP("IBOVOP",$J),IBAPPT,IBJ,IB
Q
;
APPT ; scan visits for NSC patients
; field 2="CLINIC APPT"
; field 4=clinic
; field 5=appt type
; field 6=status
S IBCL="",IBSEQ=0
F S IBCL=$O(^SC("AC","C",IBCL)) Q:IBCL="" S IBFLD4=$P($G(^SC(IBCL,0)),"^") I IBFLD4]"" S:+$G(^("AT"))=6 IBFLD4=$E(IBFLD4,1,13)_" [R]" D
.S IBJ=IBDATE F S IBJ=$O(^SC(IBCL,"S",IBJ)) Q:$E(IBJ,1,7)'=IBDATE D
..S IBIEN=0 F S IBIEN=$O(^SC(IBCL,"S",IBJ,1,IBIEN)) Q:IBIEN="" S DFN=+$G(^(IBIEN,0)) D
...Q:'$$BIL^DGMTUB(DFN,IBJ)
...Q:'$D(^DPT(DFN,"S",IBJ,0)) S IBSDATA=^(0)
...S ^TMP("IBOVOP",$J,$$FLD1(DFN),"CLINIC APPT",$$FLD3(IBJ),IBSEQ)=$E(IBFLD4,1,17)_"^"_$$FLD5($P(IBSDATA,"^",16))_"^"_$E($P($$STATUS^SDAM1(DFN,IBJ,IBCL,IBSDATA),";",3),1,17)_"^"_DFN_"^"_+$P(IBSDATA,"^",20)
Q
;
STOPCD ; scan ADD/EDIT STOP CODES for day
; field 2="STOP CODE"
; field 4=stop code
; field 5=appt type
S IBJ=IBDATE,IBSEQ=0
F S IBJ=$O(^SDV(IBJ)) Q:$E(IBJ,1,7)'=IBDATE S DFN=+$P($G(^SDV(IBJ,0)),"^",2) I $$BIL^DGMTUB(DFN,IBJ) D
.S IB="" F S IB=$O(^SDV(IBJ,"CS","B",IB)) Q:IB="" S I=$O(^(IB,0)) Q:I="" D:I
..S IBDATA=$G(^SDV(IBJ,"CS",I,0)) Q:'IBDATA
..S ^TMP("IBOVOP",$J,$$FLD1(DFN),"STOP CODE",$$FLD3(IBJ),IBSEQ)=$E($P($G(^DIC(40.7,+IBDATA,0)),"^"),1,16)_"^"_$$FLD5($P(IBDATA,"^",5))_"^^"_DFN_"^"_+$P(IBDATA,"^",8),IBSEQ=IBSEQ+1
Q
;
REGS ; registrations for day
S IBJ=IBDATE F S IBJ=$O(^DPT("ADIS",IBJ)) Q:$E(IBJ,1,7)'=IBDATE D
.S DFN="" F S DFN=$O(^DPT("ADIS",IBJ,DFN)) Q:DFN="" D
..S IBAIEN=$O(^DPT("ADIS",IBJ,DFN,0)) Q:IBAIEN=""
..S IBDATA=$G(^DPT(DFN,"DIS",IBAIEN,0)) Q:$P(IBDATA,"^",2)=2!('$$BIL^DGMTUB(DFN,$P(IBDATA,"^",6)))
..S Y=$P(IBDATA,"^",3) I Y'="" S C=$P(^DD(2.101,2,0),"^",2) D Y^DIQ
..S IBFLD4=Y
..S Y=$P(IBDATA,"^",7) I Y'="" S C=$P(^DD(2.101,6,0),"^",2) D Y^DIQ
..S ^TMP("IBOVOP",$J,$$FLD1(DFN),"REGISTRATION",$$FLD3(IBJ),IBSEQ)=$E(IBFLD4,1,16)_"^"_$E(Y,1,30)_"^^"_DFN_"^"_+$P(IBDATA,"^",18)
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^SDCO21(DFN,IBDATE,"",.IBY)
I $D(IBY(1)) S IBZ="AO"
I $D(IBY(2)) S IBZ=IBZ_$S(IBZ]"":"/",1:"")_"IR"
I $D(IBY(4)) S IBZ=IBZ_$S(IBZ]"":"/",1:"")_"EC"
Q $E($P(IBX,"^"),1,20)_" "_$E(IBX)_$P(IBX,"^",3)_$S(IBZ]"":" ["_IBZ_"]",1:"")_$S($$INSURED^IBCNS1(DFN,IBDATE):" **Insured**",1:"")
;
FLD3(Y) ; time - convert date/time to time only, no seconds
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)),"^",1),1,17)
IBOVOP1 ;ALB/RLW - Report of Visits for NSC Outpatients ; 12-JUN-92
+1 ;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94
MAIN ; perform report for day(s)
+1 DO HDR^IBOVOP2
+2 IF $$STOP^IBOUTL("Outpatient/Registration Events Report")
SET IBQUIT=1
GOTO END
+3 DO APPT
DO STOPCD
DO REGS
DO PRINT^IBOVOP2
END KILL DFN,^TMP("IBOVOP",$JOB),IBAPPT,IBJ,IB
+1 QUIT
+2 ;
APPT ; scan visits for NSC patients
+1 ; field 2="CLINIC APPT"
+2 ; field 4=clinic
+3 ; field 5=appt type
+4 ; field 6=status
+5 SET IBCL=""
SET IBSEQ=0
+6 FOR
SET IBCL=$ORDER(^SC("AC","C",IBCL))
IF IBCL=""
QUIT
SET IBFLD4=$PIECE($GET(^SC(IBCL,0)),"^")
IF IBFLD4]""
IF +$GET(^("AT"))=6
SET IBFLD4=$EXTRACT(IBFLD4,1,13)_" [R]"
Begin DoDot:1
+7 SET IBJ=IBDATE
FOR
SET IBJ=$ORDER(^SC(IBCL,"S",IBJ))
IF $EXTRACT(IBJ,1,7)'=IBDATE
QUIT
Begin DoDot:2
+8 SET IBIEN=0
FOR
SET IBIEN=$ORDER(^SC(IBCL,"S",IBJ,1,IBIEN))
IF IBIEN=""
QUIT
SET DFN=+$GET(^(IBIEN,0))
Begin DoDot:3
+9 IF '$$BIL^DGMTUB(DFN,IBJ)
QUIT
+10 IF '$DATA(^DPT(DFN,"S",IBJ,0))
QUIT
SET IBSDATA=^(0)
+11 SET ^TMP("IBOVOP",$JOB,$$FLD1(DFN),"CLINIC APPT",$$FLD3(IBJ),IBSEQ)=$EXTRACT(IBFLD4,1,17)_"^"_$$FLD5($PIECE(IBSDATA,"^",16))_"^"_$EXTRACT($PIECE($$STATUS^SDAM1(DFN,IBJ,IBCL,IBSDATA),";",3),1,17)_"^"_DFN_"^"_+$PIECE(I
BSDATA,"^",20)
End DoDot:3
End DoDot:2
End DoDot:1
+12 QUIT
+13 ;
STOPCD ; scan ADD/EDIT STOP CODES for day
+1 ; field 2="STOP CODE"
+2 ; field 4=stop code
+3 ; field 5=appt type
+4 SET IBJ=IBDATE
SET IBSEQ=0
+5 FOR
SET IBJ=$ORDER(^SDV(IBJ))
IF $EXTRACT(IBJ,1,7)'=IBDATE
QUIT
SET DFN=+$PIECE($GET(^SDV(IBJ,0)),"^",2)
IF $$BIL^DGMTUB(DFN,IBJ)
Begin DoDot:1
+6 SET IB=""
FOR
SET IB=$ORDER(^SDV(IBJ,"CS","B",IB))
IF IB=""
QUIT
SET I=$ORDER(^(IB,0))
IF I=""
QUIT
IF I
Begin DoDot:2
+7 SET IBDATA=$GET(^SDV(IBJ,"CS",I,0))
IF 'IBDATA
QUIT
+8 SET ^TMP("IBOVOP",$JOB,$$FLD1(DFN),"STOP CODE",$$FLD3(IBJ),IBSEQ)=$EXTRACT($PIECE($GET(^DIC(40.7,+IBDATA,0)),"^"),1,16)_"^"_$$FLD5($PIECE(IBDATA,"^",5))_"^^"_DFN_"^"_+$PIECE(IBDATA,"^",8)
SET IBSEQ=IBSEQ+1
End DoDot:2
End DoDot:1
+9 QUIT
+10 ;
REGS ; registrations for day
+1 SET IBJ=IBDATE
FOR
SET IBJ=$ORDER(^DPT("ADIS",IBJ))
IF $EXTRACT(IBJ,1,7)'=IBDATE
QUIT
Begin DoDot:1
+2 SET DFN=""
FOR
SET DFN=$ORDER(^DPT("ADIS",IBJ,DFN))
IF DFN=""
QUIT
Begin DoDot:2
+3 SET IBAIEN=$ORDER(^DPT("ADIS",IBJ,DFN,0))
IF IBAIEN=""
QUIT
+4 SET IBDATA=$GET(^DPT(DFN,"DIS",IBAIEN,0))
IF $PIECE(IBDATA,"^",2)=2!('$$BIL^DGMTUB(DFN,$PIECE(IBDATA,"^",6)))
QUIT
+5 SET Y=$PIECE(IBDATA,"^",3)
IF Y'=""
SET C=$PIECE(^DD(2.101,2,0),"^",2)
DO Y^DIQ
+6 SET IBFLD4=Y
+7 SET Y=$PIECE(IBDATA,"^",7)
IF Y'=""
SET C=$PIECE(^DD(2.101,6,0),"^",2)
DO Y^DIQ
+8 SET ^TMP("IBOVOP",$JOB,$$FLD1(DFN),"REGISTRATION",$$FLD3(IBJ),IBSEQ)=$EXTRACT(IBFLD4,1,16)_"^"_$EXTRACT(Y,1,30)_"^^"_DFN_"^"_+$PIECE(IBDATA,"^",18)
End DoDot:2
End DoDot:1
+9 QUIT
+10 ;
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^SDCO21(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(4))
SET IBZ=IBZ_$SELECT(IBZ]"":"/",1:"")_"EC"
+7 QUIT $EXTRACT($PIECE(IBX,"^"),1,20)_" "_$EXTRACT(IBX)_$PIECE(IBX,"^",3)_$SELECT(IBZ]"":" ["_IBZ_"]",1:"")_$SELECT($$INSURED^IBCNS1(DFN,IBDATE):" **Insured**",1:"")
+8 ;
FLD3(Y) ; time - convert date/time to time only, no seconds
+1 IF '$GET(Y)
QUIT ""
+2 XECUTE ^DD("DD")
QUIT $PIECE($PIECE(Y,"@",2),":",1,2)
+3 ;
FLD5(I) ; get appointment type name
+1 QUIT $EXTRACT($PIECE($GET(^SD(409.1,+$GET(I),0)),"^",1),1,17)
