- 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)
