- 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
