Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: ABSPOSBM

ABSPOSBM.m

Go to the documentation of this file. 
  1. ABSPOSBM ; IHS/FCS/DRS - POS billing, part 3 ;      
  1.  ;;1.0;PHARMACY POINT OF SALE;**48**;JUN 21, 2001;Build 38
  1.  ; *****
  1.  ; *****  Interface to ABSB, the ILC A/R package
  1.  ; *****  This code is reached _ONLY_ by sites using ILC A/R,
  1.  ; *****  and who choose to interface to it.
  1.  ; *****
  1.  Q
  1. CHGLIST() ; EP - from ABSPOSBX
  1.  ; Post all the charges in CHGLIST(IEN57)="" ; returns PCNDFN
  1.  K ^BLL($J),^TMP($J,"VCPT")
  1.  N VSTDFN,VCN
  1.  N IEN57 S IEN57=$O(CHGLIST(0))
  1.  S VSTDFN=$$VISITIEN^ABSPOS57
  1.  I 'VSTDFN D IMPOSS^ABSPOSUE("DB","TI","Missing visit pointer","IEN57="_IEN57,"CHGLIST",$T(+0))
  1.  S VCN=$P($G(^AUPNVSIT(VSTDFN,"VCN")),U)
  1.  I VCN="" D IMPOSS^ABSPOSUE("DB","TI","Missing VCN","VSTDFN="_VSTDFN,"CHGLIST",$T(+0))
  1.  S IEN57=0 F  S IEN57=$O(CHGLIST(IEN57)) Q:'IEN57  D
  1.  . N VCPT
  1.  . S VCPT=$$VCPT^ABSPOSBV
  1.  . S ^BLL($J,VCN,VCPT)=""
  1.  . S ^TMP($J,"VCPT",VCPT)=IEN57_U_$$RXI^ABSPOS57_U_$$RXR^ABSPOS57
  1.  D LOG^ABSPOSL($T(+0)_" - Posting for VCN="_VCN_", VSTDFN="_VSTDFN)
  1.  ;
  1.  ; Make sure the visit has a V68.1 diagnosis code
  1.  ;  (special for Sitka; available to others)
  1.  ; 
  1.  I '$P($G(^ABSP(9002313.99,1,"CREATING A/R")),U,1) D
  1.  . D V681^ABSPOSB3
  1.  ;
  1.  ; Make sure the visit has a primary provider, setting him to
  1.  ; be the prescriber if none is already defined.
  1.  ;  (Special for Sitka; available to others)
  1.  ;
  1.  I '$P($G(^ABSP(9002313.99,1,"CREATING A/R")),U,2) D
  1.  . D PROVIDER^ABSPOSB3()
  1.  ;
  1.  ; Make sure the visit has a clinic.  If not, give it the PHARMACY..
  1.  ;
  1.  I '$P($G(^ABSP(9002313.99,1,"CREATING A/R")),U,3) D
  1.  . D CLINIC^ABSPOSB3
  1.  ;
  1.  ; Finally, create the actual bill
  1.  ;
  1.  N PCNDFN
  1.  S PCNDFN=$$ABSBMAKE
  1.  I '$G(PCNDFN) D
  1.  . D LOG^ABSPOSL($T(+0)_" - ABSBMAKE failed to post charges!!")
  1.  . D IMPOSS^ABSPOSUE("P,DB","TI",,,"call to ^ABSBMAKE",$T(+0))
  1.  ;
  1.  D DTBILLED ; And update the DATE BILLED multiple
  1.  D COMMENTS ; about how much was paid and about reasons for rejects
  1.  Q PCNDFN
  1. COMMENTS ; remark about how much will be paid and give reasons for rejects
  1.  N ARRPAID,ARRREJ ; 
  1.  S IEN57=0 F  S IEN57=$O(CHGLIST(IEN57)) Q:'IEN57  D
  1.  . N R S R=$$GET1^DIQ(9002313.57,IEN57_",","RESULT WITH REVERSAL")
  1.  . I R="E PAYABLE" S ARRPAID(IEN57)=""
  1.  . E  I R="E REJECTED" S ARRREJ(IEN57)=""
  1.  I $D(ARRPAID) D PAYABLE^ABSPOSBF(PCNDFN,"Insurer will pay",.ARRPAID)
  1.  I $D(ARRREJ) D REJECTS^ABSPOSBF(PCNDFN,"Rejected claims",.ARRREJ)
  1.  Q
  1. DTBILLED ; Update the DATE BILLED multiple
  1.  N FDA,MSG,IEN57 S IEN57=$O(CHGLIST(0))
  1.  N FN,IENS S FN=9002302.04,IENS="+1,"_PCNDFN_","
  1.  S FDA(FN,IENS,.01)=DT ; DATE BILLED
  1.  N IDLIST,AMT,IEN57 S IEN57=0
  1.  F  S IEN57=$O(CHGLIST(IEN57)) Q:IEN57=""  D
  1.  . ; if it has a claim ID, it was billed electronically
  1.  . N X S X=$P(^ABSPTL(IEN57,0),U,4) Q:'X
  1.  . S IDLIST($P(^ABSPC(X,0),U))=""
  1.  . S AMT=AMT+$P(^ABSPTL(IEN57,5),U,5)
  1.  . S FDA(FN,IENS,.02)=$$FMTIDS ; DESCRIPTION
  1.  I $G(FDA(FN,IENS,.02))="" Q  ; none of them sent electronically
  1.  S FDA(FN,IENS,.03)=AMT ; AMOUNT BILLED
  1.  S FDA(FN,IENS,.04)=$$INSIEN^ABSPOS57
  1. DTB8 D UPDATE^DIE(,"FDA",,"MSG")
  1.  I $D(MSG) D LOG^ABSPOSL2("F^ABSPOSBX",.MSG) ; /IHS/OIT/RAM ; 12 JUN 17 ; AND LOG IT IF AN ERROR OCCURS.
  1.  I $D(MSG) D  G DTB8:$$IMPOSS^ABSPOSUE("FM","TRI",$T(DTBILLED),,"DTB8",$T(+0))
  1.  . D LOG^ABSPOSL("Failed to update DATE BILLED")
  1.  . D LOGARRAY^ABSPOSL("FDA")
  1.  . D LOGARRAY^ABSPOSL("MSG")
  1.  Q
  1. FMTIDS() ; format IDLIST(claim ID's) into a concise string
  1.  ; LEN agrees with ^DD(9002302.04,1) maximum length
  1.  N X,RET,LEN,FIRST S (FIRST,RET,X)=$O(IDLIST("")),LEN=50
  1.  F  S X=$O(IDLIST(X)) Q:X=""  D
  1.  . I $P(X,"-",1,2)=$P(FIRST,"-",1,2) S RET=RET_","_$P(X,"-",3)
  1.  . E  S RET=RET_";"_X,FIRST=X
  1.  I $L(RET)>LEN S RET=$E(RET,1,LEN-3)_"..."
  1.  E  I $L(RET)+4'>LEN S RET="POS "_RET
  1.  Q RET
  1. ABSBMAKE() ;
  1.  ; We have ^BLL, ^TMP as above; also VCN,VSTDFN and lots of other stuff
  1.  ; Return PCNDFN
  1.  N ARTYPNUM D ARTYPNUM ; set the right ARTYPNUM for these charges
  1.  I $D(^AUPNVSIT(VSTDFN,"PINS")) S ^TMP($J,"SAVE PINS")=^AUPNVSIT(VSTDFN,"PINS")
  1.  E  K ^TMP($J,"SAVE PINS")
  1.  I $D(^AUPNVSIT(VSTDFN,"PCN")) S ^TMP($J,"SAVE PCN")=^AUPNVSIT(VSTDFN,"PCN")
  1.  E  K ^TMP($J,"SAVE PCN")
  1.  N PINS D PINS
  1.  D  ; fix old style CAID,2352 -> CAID,2352,0
  1.  . ; affects only those created under old and being posted under new
  1.  . N I F I=1:1:$L(PINS,U) D
  1.  . . N X S X=$P(PINS,U,I)
  1.  . . I $L(X,",")=2 S $P(X,",",3)=0,$P(PINS,U,I)=X
  1.  S ^AUPNVSIT(VSTDFN,"PINS")=PINS
  1.  S $P(^AUPNVSIT(VSTDFN,"PCN"),U)=ARTYPNUM
  1.  N PCN,BAL,PCNDFN
  1.  D
  1.  . N BLLTYP S BLLTYP="OP"
  1.  . N FIXINDEX S FIXINDEX=0
  1.  . I '$O(^AUPNVSIT("VCN",VCN,"")) D
  1.  . . D LOG^ABSPOSL("DELETED VISIT FOR "_VCN_" INTERNAL NUMBER "_VSTDFN)
  1.  . . D LOG^ABSPOSL("We're going to post charges to it anyway.")
  1.  . . S ^AUPNVSIT("VCN",VCN,VSTDFN)=""
  1.  . . S FIXINDEX=1
  1.  . ;D LOG^ABSPOSB3("with ^AUPNVSIT("_VSTDFN_",""PINS"")="_$G(^AUPNVSIT(VSTDFN,"PINS")))
  1.  . ; Use the "null file" for ^ABSBMAKE output
  1. AM6 . I '$$NULLOPEN D  G AM6:$$IMPOSS^ABSPOSUE("DEV","IRT","$$NULLOPEN",,"AM6",$T(+0))
  1.  . D COMBINS ; - - - - - - - UPDATE COMBINED INSURANCE - - - - - - -
  1.  . D ^ABSBMAKE ; - - - - - - - - -  CREATE THE BILL - - - - - - - -
  1.  . D NULLCLOS
  1.  . I FIXINDEX D
  1.  . . K ^AUPNVSIT("VCN",VCN,VSTDFN)
  1.  . S PCN=$P(^ABSBITMS(9002302,PCNDFN,0),U)
  1.  . S BAL=$P(^ABSBITMS(9002302,PCNDFN,3),U)
  1.  ; restore the old PINS and PCN TYPE to the visit
  1.  I $D(^TMP($J,"SAVE PINS")) S ^AUPNVSIT(VSTDFN,"PINS")=^TMP($J,"SAVE PINS") K ^TMP($J,"SAVE PINS")
  1.  E  K ^AUPNVSIT(VSTDFN,"PINS")
  1.  I $D(^TMP($J,"SAVE PCN")) S ^AUPNVSIT(VSTDFN,"PCN")=^TMP($J,"SAVE PCN")
  1.  E  K ^AUPNVSIT(VSTDFN,"PCN")
  1.  I '$G(PCNDFN) D  Q ""
  1.  . D LOG^ABSPOSL("* * * * * ERROR:  did not create A/R for VN="_VCN_",VSTDFN="_VSTDFN)
  1.  . D LOG^ABSPOSL("This is the ^BLL($J) contents:")
  1.  . N TMP M TMP=^BLL($J)
  1.  . D LOGARRAY^ABSPOSL("TMP")
  1.  . D LOG^ABSPOSL("This is the ^TMP($J,""VCPT"") contents:")
  1.  . K TMP M TMP=^TMP($J,"VCPT")
  1.  . D LOGARRAY^ABSPOSL("TMP")
  1.  N PAT D
  1.  . N N D FIRSTN
  1.  . S PAT=$P(^ABSPTL(N,0),U,6)
  1.  . S PAT=$P(^DPT(PAT,0),U)
  1.  N X S X=PAT_"  VCN "_VCN_"  PCN "_PCN
  1.  S X=X_"  $"_$J(BAL,0,2)
  1.  S X=X_" posted"
  1.  D LOG^ABSPOSL(X) ;,$G(ECHO)) 
  1.  N VCPT S VCPT=0 F  S VCPT=$O(^BLL($J,VCN,VCPT)) Q:'VCPT  D
  1.  . N N,RXI,RXR
  1.  . S N=^TMP($J,"VCPT",VCPT),RXI=$P(N,U,2),RXR=$P(N,U,3),N=$P(N,U)
  1.  . N N57 S N57=N ; maybe, in case fileman blows away N
  1.  . D LINEITEM ; log file detail of the charge
  1.  . D MARKVCPT ; note RXI, RXR on the VCPT
  1.  . D UPDATE57 ; record in .57 file that this entry has been billed
  1.  . D UPDATE02 ; 9002313.02 claim points to PCN
  1.  . I $$GET1^DIQ(9002313.57,N57_",","RESULT WITH REVERSAL")?1"E ".E D
  1.  . . D OFFNCPDP^ABSBPBRX(PCNDFN) ; electronic claim? do not print form.
  1.  Q PCNDFN
  1. COMBINS ; have to update the combined insurance file?  Yes. 
  1.  ; because DO ^ABSBMAKE refers back to combined insurance.
  1.  ; (This is new.  Sitka didn't need it because back then,
  1.  ;  ILC and Point of Sale used the same ^ABSBCOMB.)
  1.  N PATDFN S PATDFN=$P(^AUPNVSIT(VSTDFN,0),U,5)
  1.  I $D(^ABSBCOMB) D  ; FSI/ILC A/R Version 2
  1.  . D EN^VTLCOMB(PATDFN)
  1.  E  D  ; FSI/ILC A/R Version 1
  1.  . N D1,ELGBEG,ELGEND,GRPDFN,GRPNAM,GRPNUM,INSDFN,INSNAM
  1.  . N POLDFN,POLNAM,POLNUM,POLREC,REC,REL,X
  1.  . D ^ABSBCOMB(PATDFN)
  1.  Q
  1. LINEITEM         ;
  1.  N DRGDFN,NDC,DRGNAME,CHARGE,X,QTY
  1.  S DRGDFN=$P(^PSRX(RXI,0),U,6)
  1.  S NDC=$P(^ABSPTL(N57,1),U,2) ; fixed 03/26/2001
  1.  S DRGNAME=$P($G(^PSDRUG(DRGDFN,0)),U)
  1.  S CHARGE=$P(^ABSVCPT(9002301,VCPT,0),U,5)
  1.  S QTY=$P(^ABSPTL(N57,5),U)
  1.  I QTY#1 S QTY=$J(QTY,8,3)
  1.  E  S QTY=$J(QTY,4)
  1.  S X=QTY_" "_$$ANFF^ABSPECFM(DRGNAME,25)_"  "
  1.  S X=X_$$ANFF^ABSPECFM($$FORMTNDC^ABSPOS9(NDC),13)
  1.  S X=X_" "_$J(CHARGE,8,2)
  1.  S X=X_"  ("_VCPT_")"
  1.  D LOG^ABSPOSL(X)
  1.  Q
  1. MARKVCPT         ; 
  1.  N DIE,DA,DR,DIDEL,DTOUT
  1.  S DIE=9002301,DA=VCPT,DR="56////"_RXI_";56.3////"_RXR_";56.4////"_N57
  1.  D ^DIE
  1.  Q
  1. UPDATE57     ; record in POS data that this VCPT has been billed
  1.  N DIE,DA,DR,DIDEL,DTOUT
  1.  S DIE=9002313.57,DA=N57,DR="2////"_PCNDFN D ^DIE
  1.  Q
  1.  Q
  1. UPDATE02 ;
  1.  N DIE,DA,DR,DIDEL,DTOUT
  1.  S DIE=9002313.02,DA=$P(^ABSPTL(N57,0),U,4)
  1.  Q:'DA
  1.  S DR=".03////"_PCNDFN_";1.02///"_PCN_";1.03///"_VCN
  1.  D ^DIE
  1.  Q
  1. ARTYPNUM ; determine the AR TYPE number for the current VCN
  1.  N OK,PHARM
  1. ART2 S OK=1
  1.  D FIRSTN
  1.  S PHARM=$P(^ABSPTL(N,1),U,7) ; point to .56
  1.  S ARTYPNUM=$P(^ABSP(9002313.56,PHARM,0),U,4)
  1.  I 'ARTYPNUM S ARTYPNUM=$P(^ABSP(9002313.99,1,"RX A/R TYPE"),U)
  1.  I 'ARTYPNUM S OK=0
  1.  I OK I '$D(^ABSBTYP(ARTYPNUM)) S OK=0 ; be overly cautious about this
  1.  I 'OK G ART2:$$IMPOSS^ABSPOSUE("DB","RTI","A/R TYPE missing from setup file",,"ARTYPNUM",$T(+0))
  1.  Q
  1. PINS ; set PINS = the right PINS node for this VCN
  1.  D FIRSTN
  1.  S PINS=^ABSPTL(N,6)
  1.  Q
  1. FIRSTN ; S N=first 9002313.57 for the first VCPT for this VCN
  1.  ; used by ARTYPNUM and PINS
  1.  N VCPT S VCPT=$O(^BLL($J,VCN,0))
  1.  I 'VCPT D  Q  ; get first VCPT
  1.  . D IMPOSS^ABSPOSUE("P","TI","Incomplete ^BLL array",,"FIRSTN",$T(+0))
  1.  S N=$P(^TMP($J,"VCPT",VCPT),U) ; point to the 9002313.57 record
  1.  Q
  1. NULLOPEN() ; open null file, because ^ABSBMAKE echoes to screen
  1.  S X=$$GET1^DIQ(9002313.99,"1,",1490)
  1.  N DIR,FILE,SLASH,SLASHCH
  1.  S SLASH=$S(X["/":"/",X["\":"\",1:"")
  1.  I SLASH]"" D
  1.  . N N S N=$L(X,SLASH)
  1.  . S DIR=$P(X,SLASH,1,N-1)_SLASH
  1.  . S FILE=$P(X,SLASH,N)
  1.  E  D
  1.  . I X="" S DIR="",FILE=$T(+0)_".tmp"
  1.  . E  S DIR="",FILE=X
  1.  D OPEN^%ZISH($$NULLHNDL,DIR,FILE,"W")
  1.  Q '$G(POP) ; 1 success, 0 failure
  1. NULLCLOS D CLOSE^%ZISH($$NULLHNDL) Q
  1. NULLHNDL() Q 54