ABSPOSBV ; IHS/FCS/DRS - ILC A/R billing interface ;
;;1.0;PHARMACY POINT OF SALE;**48**;JUN 21, 2001;Build 38
Q
;
VCPT() ;EP - from ABSPOSQB
; create new VCPT entry based on ^ABSPTL(IEN57,...)
; First, lookup in charge file, possibly having to create a new entry
N CPTIEN S CPTIEN=$$CPTIEN^ABSPOS57
I 'CPTIEN S CPTIEN=$$NEWCPT I 'CPTIEN Q ""
; Now that it exists in the charge file, you can create VCPT
N VCPTIEN,FDA,IEN,MSG,FN,PLUS1 S FN=9002301,PLUS1="+1," ; /IHS/OIT/RAM ; 9 JUN 17 ; FILE NUMBER 9002301 _DOESN'T EVEN EXIST..._
; The .01 field points to the charge file
S FDA(FN,PLUS1,.01)=CPTIEN
;
; FDA setup specific to the type of charge:
;
I $$TYPE=1!($$TYPE=2) D ; prescription or postage, either one
. S FDA(FN,PLUS1,1.5)=$$FILLDATE^ABSPOS57
. ; VCPT, (#58) DATE OF SERVICE - take fill date, not the visit date.
. ; ex. Mt. Edgecumbe, presc. `341641 has PCC link to a 1990 visit
. ; but a May, 2000 fill date
. S FDA(FN,PLUS1,58)=FDA(FN,PLUS1,1.5) ; DATE OF SERVICE, same
. I $D(^DD(FN,74)) D ; Sitka didn't have this field on 06/21/2000
. . S FDA(FN,PLUS1,74)=$$PROVIDER^ABSPOS57
. S FDA(FN,PLUS1,56)=$$RXI^ABSPOS57
. S FDA(FN,PLUS1,56.2)=$$VMED^ABSPOS57
. S FDA(FN,PLUS1,56.3)=$$RXR^ABSPOS57
E I $$TYPE=3 D
. S FDA(FN,PLUS1,58)=$$FILLDATE^ABSPOS57 ;$P(^AUPNVSIT($$VISITIEN,0),U)
;
; FDA setup regardless of type of charge
;
S FDA(FN,PLUS1,.02)=$$PATIENT^ABSPOS57
S FDA(FN,PLUS1,.03)=$$VISITIEN^ABSPOS57
S FDA(FN,PLUS1,2)=$$CHG^ABSPOS57
S FDA(FN,PLUS1,4)=$$USER^ABSPOS57
S FDA(FN,PLUS1,4.5)=$$NOW^ABSPOS57
S FDA(FN,PLUS1,52)=$$VCN^ABSPOS57
S FDA(FN,PLUS1,53)=$$QTY^ABSPOS57
;
I $D(^DD(FN,59.2)) D ; Sitka didn't have this field on 06/21/2000
. S FDA(FN,PLUS1,59.2)=$P(^ABSCPT(9002300,CPTIEN,0),U,6) ; REV CODE
D UPDATE^DIE("S","FDA","IEN","MSG")
I $D(MSG) D LOG^ABSPOSL2("VCPT^ABSPOSBV",.MSG) ; /IHS/OIT/RAM ; 9 JUN 17 ; AND LOG IT IF AN ERROR OCCURS.
I $D(MSG) D
. D LOG^ABSPOSL("Failed to create VCPT entry!")
. D LOGARRAY("FDA"),LOGARRAY("IEN"),LOGARRAY("MSG")
Q $G(IEN(1))
LOGARRAY(X) D LOGARRAY^ABSPOSL(X) Q
NEWCPT() ; create new CPT entry based on ^ABSPTL(IEN57,...)
N FDA,MSG,FN,PLUS1 S FN=9002300,PLUS1="+1," ;; /IHS/OIT/RAM ; 9 JUN 17 ; FILE NUMBER 9002300 _DOESN'T EVEN EXIST..._
D LOG^ABSPOSL("Creating new CPT code for IEN57="_IEN57)
I $$TYPE=1 D
. S FDA(FN,PLUS1,.01)=$$NDC^ABSPOS57 ; CODE
. S FDA(FN,PLUS1,1)=$$DRGNAME^ABSPOS57 ; SHORT DESCRIPTION
. S FDA(FN,PLUS1,2)=$$DRGNAME^ABSPOS57 ; LONG DESCRIPTION
. ; S FDA(FN,PLUS1,3) ; LOOKUP
. S FDA(FN,PLUS1,4)=$P($G(^ABSPTL(IEN57,5)),U,2) ; RATE
. ;S FDA(FN,PLUS1,5)=$O(^ABSREV(
. S FDA(FN,PLUS1,101)=$$DRGDFN^ABSPOS57 ; DRUG FILE POINTER
. S FDA(FN,PLUS1,102)=$$NDC^ABSPOS57 ; NDC #
. ; 103)=BRAND NAME ; could get from ^APSAMDF?
E I $$TYPE=2 D
. D IMPOSS^ABSPOSUE("P","TI","New charge file entry for postage items not yet implemented",,"NEWCPT",$T(+0))
E I $$TYPE=3 D
. D IMPOSS^ABSPOSUE("P","TI","New charge file entry for supply items not yet implemented",,"NEWCPT",$T(+0))
E D IMPOSS^ABSPOSUE("P","TI","Unaccounted-for $$TYPE="_$$TYPE,,"NEWCPT",$T(+0))
NEW8 D UPDATE^DIE("S","FDA","IEN","MSG")
I $D(MSG) D LOG^ABSPOSL2("NEW8^ABSPOSBV",.MSG) ; /IHS/OIT/RAM ; 9 JUN 17 ; AND LOG IT IF AN ERROR OCCURS.
I $D(MSG) D G NEW8:$$IMPOSS^ABSPOSUE("FM","TRI","UPDATE^DIE failed",.MSG,"NEWCPT",$T(+0))
. D LOG^ABSPOSL("Failed to create a new CPT code!")
. D LOGARRAY("FDA"),LOGARRAY("IEN"),LOGARRAY("MSG")
E D
. D LOG^ABSPOSL("New CPT code is at ^ABSCPT(9002300,"_IEN(1)_")")
Q $G(IEN(1))
TYPE() Q $$TYPE^ABSPOS57 ; and it traps out-of-range values
ABSPOSBV ; IHS/FCS/DRS - ILC A/R billing interface ;
+1 ;;1.0;PHARMACY POINT OF SALE;**48**;JUN 21, 2001;Build 38
+2 QUIT
+3 ;
VCPT() ;EP - from ABSPOSQB
+1 ; create new VCPT entry based on ^ABSPTL(IEN57,...)
+2 ; First, lookup in charge file, possibly having to create a new entry
+3 NEW CPTIEN
SET CPTIEN=$$CPTIEN^ABSPOS57
+4 IF 'CPTIEN
SET CPTIEN=$$NEWCPT
IF 'CPTIEN
QUIT ""
+5 ; Now that it exists in the charge file, you can create VCPT
+6 ; /IHS/OIT/RAM ; 9 JUN 17 ; FILE NUMBER 9002301 _DOESN'T EVEN EXIST..._
NEW VCPTIEN,FDA,IEN,MSG,FN,PLUS1
SET FN=9002301
SET PLUS1="+1,"
+7 ; The .01 field points to the charge file
+8 SET FDA(FN,PLUS1,.01)=CPTIEN
+9 ;
+10 ; FDA setup specific to the type of charge:
+11 ;
+12 ; prescription or postage, either one
IF $$TYPE=1!($$TYPE=2)
Begin DoDot:1
+13 SET FDA(FN,PLUS1,1.5)=$$FILLDATE^ABSPOS57
+14 ; VCPT, (#58) DATE OF SERVICE - take fill date, not the visit date.
+15 ; ex. Mt. Edgecumbe, presc. `341641 has PCC link to a 1990 visit
+16 ; but a May, 2000 fill date
+17 ; DATE OF SERVICE, same
SET FDA(FN,PLUS1,58)=FDA(FN,PLUS1,1.5)
+18 ; Sitka didn't have this field on 06/21/2000
IF $DATA(^DD(FN,74))
Begin DoDot:2
+19 SET FDA(FN,PLUS1,74)=$$PROVIDER^ABSPOS57
End DoDot:2
+20 SET FDA(FN,PLUS1,56)=$$RXI^ABSPOS57
+21 SET FDA(FN,PLUS1,56.2)=$$VMED^ABSPOS57
+22 SET FDA(FN,PLUS1,56.3)=$$RXR^ABSPOS57
End DoDot:1
+23 IF '$TEST
IF $$TYPE=3
Begin DoDot:1
+24 ;$P(^AUPNVSIT($$VISITIEN,0),U)
SET FDA(FN,PLUS1,58)=$$FILLDATE^ABSPOS57
End DoDot:1
+25 ;
+26 ; FDA setup regardless of type of charge
+27 ;
+28 SET FDA(FN,PLUS1,.02)=$$PATIENT^ABSPOS57
+29 SET FDA(FN,PLUS1,.03)=$$VISITIEN^ABSPOS57
+30 SET FDA(FN,PLUS1,2)=$$CHG^ABSPOS57
+31 SET FDA(FN,PLUS1,4)=$$USER^ABSPOS57
+32 SET FDA(FN,PLUS1,4.5)=$$NOW^ABSPOS57
+33 SET FDA(FN,PLUS1,52)=$$VCN^ABSPOS57
+34 SET FDA(FN,PLUS1,53)=$$QTY^ABSPOS57
+35 ;
+36 ; Sitka didn't have this field on 06/21/2000
IF $DATA(^DD(FN,59.2))
Begin DoDot:1
+37 ; REV CODE
SET FDA(FN,PLUS1,59.2)=$PIECE(^ABSCPT(9002300,CPTIEN,0),U,6)
End DoDot:1
+38 DO UPDATE^DIE("S","FDA","IEN","MSG")
+39 ; /IHS/OIT/RAM ; 9 JUN 17 ; AND LOG IT IF AN ERROR OCCURS.
IF $DATA(MSG)
DO LOG^ABSPOSL2("VCPT^ABSPOSBV",.MSG)
+40 IF $DATA(MSG)
Begin DoDot:1
+41 DO LOG^ABSPOSL("Failed to create VCPT entry!")
+42 DO LOGARRAY("FDA")
DO LOGARRAY("IEN")
DO LOGARRAY("MSG")
End DoDot:1
+43 QUIT $GET(IEN(1))
LOGARRAY(X) DO LOGARRAY^ABSPOSL(X)
QUIT
NEWCPT() ; create new CPT entry based on ^ABSPTL(IEN57,...)
+1 ;; /IHS/OIT/RAM ; 9 JUN 17 ; FILE NUMBER 9002300 _DOESN'T EVEN EXIST..._
NEW FDA,MSG,FN,PLUS1
SET FN=9002300
SET PLUS1="+1,"
+2 DO LOG^ABSPOSL("Creating new CPT code for IEN57="_IEN57)
+3 IF $$TYPE=1
Begin DoDot:1
+4 ; CODE
SET FDA(FN,PLUS1,.01)=$$NDC^ABSPOS57
+5 ; SHORT DESCRIPTION
SET FDA(FN,PLUS1,1)=$$DRGNAME^ABSPOS57
+6 ; LONG DESCRIPTION
SET FDA(FN,PLUS1,2)=$$DRGNAME^ABSPOS57
+7 ; S FDA(FN,PLUS1,3) ; LOOKUP
+8 ; RATE
SET FDA(FN,PLUS1,4)=$PIECE($GET(^ABSPTL(IEN57,5)),U,2)
+9 ;S FDA(FN,PLUS1,5)=$O(^ABSREV(
+10 ; DRUG FILE POINTER
SET FDA(FN,PLUS1,101)=$$DRGDFN^ABSPOS57
+11 ; NDC #
SET FDA(FN,PLUS1,102)=$$NDC^ABSPOS57
+12 ; 103)=BRAND NAME ; could get from ^APSAMDF?
End DoDot:1
+13 IF '$TEST
IF $$TYPE=2
Begin DoDot:1
+14 DO IMPOSS^ABSPOSUE("P","TI","New charge file entry for postage items not yet implemented",,"NEWCPT",$TEXT(+0))
End DoDot:1
+15 IF '$TEST
IF $$TYPE=3
Begin DoDot:1
+16 DO IMPOSS^ABSPOSUE("P","TI","New charge file entry for supply items not yet implemented",,"NEWCPT",$TEXT(+0))
End DoDot:1
+17 IF '$TEST
DO IMPOSS^ABSPOSUE("P","TI","Unaccounted-for $$TYPE="_$$TYPE,,"NEWCPT",$TEXT(+0))
NEW8 DO UPDATE^DIE("S","FDA","IEN","MSG")
+1 ; /IHS/OIT/RAM ; 9 JUN 17 ; AND LOG IT IF AN ERROR OCCURS.
IF $DATA(MSG)
DO LOG^ABSPOSL2("NEW8^ABSPOSBV",.MSG)
+2 IF $DATA(MSG)
Begin DoDot:1
+3 DO LOG^ABSPOSL("Failed to create a new CPT code!")
+4 DO LOGARRAY("FDA")
DO LOGARRAY("IEN")
DO LOGARRAY("MSG")
End DoDot:1
IF $$IMPOSS^ABSPOSUE("FM","TRI","UPDATE^DIE failed",.MSG,"NEWCPT",$TEXT(+0))
GOTO NEW8
+5 IF '$TEST
Begin DoDot:1
+6 DO LOG^ABSPOSL("New CPT code is at ^ABSCPT(9002300,"_IEN(1)_")")
End DoDot:1
+7 QUIT $GET(IEN(1))
TYPE() ; and it traps out-of-range values
QUIT $$TYPE^ABSPOS57
