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

ABSPOSBH.m

Go to the documentation of this file. 
  1. ABSPOSBH ; IHS/SD/RLT - POS billing - HOLD ;        [ 09/12/2007  11:18 AM ]
  1.  ;;1.0;PHARMACY POINT OF SALE;**22,28**;SEP 12, 2007;Build 38
  1.  ;
  1.  ; Code to hold claims from being sent to 3PB if the site
  1.  ; affiliation is IHS and the insurer does not have a tax id.
  1.  ; 
  1.  ; This routine handles the holding and releasing of these claims.
  1.  ; 
  1.  ; -------------------------------------------------------------------------------------
  1.  ; IHS/OIT/SCR 9/16/08 patch 28 REMOVED all functionality to put claims in HOLD
  1.  ;   status.
  1.  ; -------------------------------------------------------------------------------------
  1.  Q
  1.  ; IHS/OIT/SCR 9/23/08 - Patch 28 START CHANGES
  1.  ;HOLDFLG(LOC,VISDT,INSDFN) ;EP - ABSPOSBB
  1.  ;
  1.  ; Claims from sites flagged as IHS must have insurer tax ids
  1.  ; to send to 3PB.
  1.  ;
  1.  ; 1 = don't send to 3PB put on hold
  1.  ; 0 = send to 3PB
  1.  ; Get affiliation.
  1.  ;     1 = IHS
  1.  ;N CLASSFND,CLASS,BEGDT,ENDDT,AFFL
  1.  ;S AFFL=""
  1.  ;S CLASSFND=0
  1.  ;S CLASS="A"
  1.  ;F  S CLASS=$O(^AUTTLOC(LOC,11,CLASS),-1) Q:CLASS=0!(CLASSFND)  D
  1.  ;. S BEGDT=$S($P(^AUTTLOC(LOC,11,CLASS,0),U)]"":$P(^AUTTLOC(LOC,11,CLASS,0),U),1:0)
  1.  ;. S ENDDT=$S($P(^AUTTLOC(LOC,11,CLASS,0),U,2)]"":$P(^AUTTLOC(LOC,11,CLASS,0),U,2),1:9999999)
  1.  ;. I VISDT'<BEGDT&(VISDT'>ENDDT) S AFFL=$P(^AUTTLOC(LOC,11,CLASS,0),U,3),CLASSFND=1
  1.  ;;
  1.  ;; Get insurer tax id.
  1.  ;N TAXID
  1.  ;S TAXID=$P($G(^AUTNINS(INSDFN,0)),U,11)
  1.  ;
  1.  ; If affiliation is IHS and no insurer tax id don't send to 3PB put on hold.
  1.  ;I AFFL=1&(TAXID="") Q 1
  1.  ;Q 0
  1.  ;HOLDITP(ABSP) ;EP - ABSPOSBB
  1.  ; Put post on hold.
  1.  ;
  1.  ;N LOG
  1.  ;D NOW^%DTC
  1.  ;S LOG=%
  1.  ;
  1.  ;D ^XBFMK      ;kill FileMan variables
  1.  ;K DD,DO
  1.  ;S DIC="^ABSPHOLD("
  1.  ;S DIC(0)="L"
  1.  ;S DINUM=LOG
  1.  ;S DINUM=ABSP57
  1.  ;S X=ABSP57
  1.  ;
  1.  ;D FILE^DICN
  1.  ;
  1.  ;Q:+Y<0
  1.  ;
  1.  ;S $P(^ABSPHOLD(ABSP57,0),U,2)="P"
  1.  ;
  1.  ;S $P(^ABSPHOLD(ABSP57,"P"),U,1)=ABSP(.21)             ; Bill amount
  1.  ;S $P(^ABSPHOLD(ABSP57,"P"),U,2)=ABSP(.23)             ; Gross amount
  1.  ;S $P(^ABSPHOLD(ABSP57,"P"),U,3)=ABSP(.05)             ; Patient
  1.  ;S $P(^ABSPHOLD(ABSP57,"P"),U,4)=ABSP(.71)             ; Service date from
  1.  ;S $P(^ABSPHOLD(ABSP57,"P"),U,5)=ABSP(.72)             ; Service date to
  1.  ;S $P(^ABSPHOLD(ABSP57,"P"),U,6)=ABSP(.1)              ; Clinic
  1.  ;S $P(^ABSPHOLD(ABSP57,"P"),U,7)=ABSP(.03)             ; Visit location
  1.  ;S $P(^ABSPHOLD(ABSP57,"P"),U,8)=ABSP(.08)             ; Active insurer
  1.  ;S $P(^ABSPHOLD(ABSP57,"P"),U,9)=ABSP(.58)             ; Prior Authorization
  1.  ;S $P(^ABSPHOLD(ABSP57,"P"),U,10)=ABSP(.14)            ; Approving Official
  1.  ;S $P(^ABSPHOLD(ABSP57,"P2"),U,1)=ABSP(41,.01)         ; Provider
  1.  ;S $P(^ABSPHOLD(ABSP57,"P2"),U,2)=ABSP(23,.01)         ; Medication
  1.  ;S $P(^ABSPHOLD(ABSP57,"P2"),U,3)=ABSP(23,.03)         ; Quantity
  1.  ;S $P(^ABSPHOLD(ABSP57,"P2"),U,4)=ABSP(23,.04)         ; Unit Price
  1.  ;S $P(^ABSPHOLD(ABSP57,"P2"),U,5)=ABSP(23,.05)         ; Dispensing Fee
  1.  ;S $P(^ABSPHOLD(ABSP57,"P2"),U,6)=ABSP(23,19)          ; New/Refill code
  1.  ;S $P(^ABSPHOLD(ABSP57,"P2"),U,7)=ABSP(23,.06)         ; Prescription
  1.  ;S $P(^ABSPHOLD(ABSP57,"P2"),U,8)=ABSP(23,14)          ; Date filled
  1.  ;S $P(^ABSPHOLD(ABSP57,"P2"),U,9)=ABSP(23,20)          ; Days supply
  1.  ;S $P(^ABSPHOLD(ABSP57,"P2"),U,10)=ABSP("OTHIDENT")    ; Other Bill Identifier
  1.  ;Q
  1.  ;HOLDITR(ABSP) ;EP - ABSPOSBB
  1.  ; Put reversal on hold.
  1.  ;
  1.  ;N LOG
  1.  ;D NOW^%DTC
  1.  ;S LOG=%
  1.  ;
  1.  ;D ^XBFMK      ;kill FileMan variables
  1.  ;K DD,DO
  1.  ;S DIC="^ABSPHOLD("
  1.  ;S DIC(0)="L"
  1.  ;S DINUM=LOG
  1.  ;S DINUM=ABSP57
  1.  ;S X=ABSP57
  1.  ;
  1.  ;D FILE^DICN
  1.  ;
  1.  ;Q:+Y<0
  1.  ;
  1.  ;S $P(^ABSPHOLD(ABSP57,0),U,2)="R"
  1.  ;
  1.  ;S $P(^ABSPHOLD(ABSP57,"R"),U,1)=LOC
  1.  ;S $P(^ABSPHOLD(ABSP57,"R"),U,2)=VISDT
  1.  ;S $P(^ABSPHOLD(ABSP57,"R"),U,3)=INSDFN
  1.  ;S $P(^ABSPHOLD(ABSP57,"R"),U,4)=ABSP("CREDIT")        ; $$ to reverse
  1.  ;S $P(^ABSPHOLD(ABSP57,"R"),U,5)=ABSP("ARLOC")         ; A/R Bill location
  1.  ;S $P(^ABSPHOLD(ABSP57,"R"),U,6)=ABSP("TRAN TYPE")     ; Adjustment
  1.  ;S $P(^ABSPHOLD(ABSP57,"R"),U,7)=ABSP("ADJ CAT")       ; Write off
  1.  ;S $P(^ABSPHOLD(ABSP57,"R"),U,8)=ABSP("ADJ TYPE")      ; Billed in error
  1.  ;S $P(^ABSPHOLD(ABSP57,"R"),U,9)=ABSP("USER")          ; User who entered tran
  1.  ;Q
  1.  ; CHKHOLD ;EP - ABSPOSBD
  1.  ;CHKHOLD(HOLDIEN) ;EP - ABSPOSJ1 (pre-init routine that calls to clear HOLD queue)
  1.  ; Process to check the hold claim.
  1.  ;
  1.  ;N HOLD57,HOLDTYP,HOLDREC,HOLDLOC,HOLDVDT,HOLDINS,HOLDFLG,HOLDDA
  1.  ;
  1.  ;S HOLD57=$P($G(^ABSPHOLD(HOLDIEN,0)),U)
  1.  ;S HOLDTYP=$P($G(^ABSPHOLD(HOLDIEN,0)),U,2)
  1.  ;I HOLDTYP="P" D
  1.  ;. S HOLDREC=$G(^ABSPHOLD(HOLDIEN,"P"))
  1.  ;. S HOLDLOC=$P(HOLDREC,U,7)
  1.  ;. S HOLDVDT=$P(HOLDREC,U,4)
  1.  ;. S HOLDINS=$P(HOLDREC,U,8)
  1.  ;I HOLDTYP="R" D
  1.  ;. S HOLDREC=$G(^ABSPHOLD(HOLDIEN,"R"))
  1.  ;. S HOLDLOC=$P(HOLDREC,U,1)
  1.  ;. S HOLDVDT=$P(HOLDREC,U,2)
  1.  ;. S HOLDINS=$P(HOLDREC,U,3)
  1.  ;I HOLDTYP'="P"&(HOLDTYP'="R") Q
  1.  ;S HOLDFLG=$$HOLDFLG^ABSPOSBH(HOLDLOC,HOLDVDT,HOLDINS)
  1.  ; Tax id still not found leave on hold
  1.  ;I HOLDFLG D  Q
  1.  ;. ;D LOG^ABSPOSL("Holding for taxid "_HOLD57_".")
  1.  ;. S HOLDCNT=HOLDCNT+1
  1.  ;
  1.  ; Tax id found send to 3PB
  1.  ;I HOLDTYP="P" D POSTIT
  1.  ;I HOLDTYP="R" D REVERSIT
  1.  ;
  1.  ;I HOLDDA]"" D
  1.  ;. N FDA,IEN,MSG
  1.  ;. S FDA(9002313.57,HOLD57_",",.15)=HOLDDA
  1.  ;. D FILE^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.  ;
  1.  ; Transaction processed remove entry from hold file
  1.  ;D ^XBFMK      ;kill FileMan variables
  1.  ;S DIK="^ABSPHOLD("
  1.  ;S DA=HOLDIEN
  1.  ;D ^DIK
  1.  ;
  1.  ;Q
  1.  ;POSTIT ;
  1.  ;N ABSP,ABSPOST,HOLDREC2
  1.  ;
  1.  ;S ABSP(.21)=$P(HOLDREC,U,1)                 ; Bill amount
  1.  ;S ABSP(.23)=$P(HOLDREC,U,2)                 ; Gross amount
  1.  ;S ABSP(.05)=$P(HOLDREC,U,3)                 ; Patient
  1.  ;S ABSP(.71)=$P(HOLDREC,U,4)                 ; Service date from
  1.  ;S ABSP(.72)=$P(HOLDREC,U,5)                 ; Service date to
  1.  ;S ABSP(.1)=$P(HOLDREC,U,6)                  ; Clinic
  1.  ;S ABSP(.03)=$P(HOLDREC,U,7)                 ; Visit location
  1.  ;S ABSP(.08)=$P(HOLDREC,U,8)                 ; Active insurer
  1.  ;S ABSP(.58)=$P(HOLDREC,U,9)                 ; Prior Authorization
  1.  ;S ABSP(.14)=$P(HOLDREC,U,10)                ; Approving Official
  1.  ;S HOLDREC2=$G(^ABSPHOLD(HOLDIEN,"P2"))
  1.  ;S ABSP(41,.01)=$P(HOLDREC2,U,1)             ; Provider
  1.  ;S ABSP(23,.01)=$P(HOLDREC2,U,2)             ; Medication
  1.  ;S ABSP(23,.03)=$P(HOLDREC2,U,3)             ; Quantity
  1.  ;S ABSP(23,.04)=$P(HOLDREC2,U,4)             ; Unit Price
  1.  ;S ABSP(23,.05)=$P(HOLDREC2,U,5)             ; Dispensing Fee
  1.  ;S ABSP(23,19)=$P(HOLDREC2,U,6)              ; New/Refill code
  1.  ;S ABSP(23,.06)=$P(HOLDREC2,U,7)             ; Prescription
  1.  ;S ABSP(23,14)=$P(HOLDREC2,U,8)              ; Date filled
  1.  ;S ABSP(23,20)=$P(HOLDREC2,U,9)              ; Days supply
  1.  ;S ABSP("OTHIDENT")=$P(HOLDREC2,U,10)        ; Other Bill Identifier
  1.  ;S INSDFN=ABSP(.08)
  1.  ;
  1.  ;D LOG^ABSPOSL("Posting transaction "_HOLD57_".")
  1.  ;S ABSPOST=$$EN^ABMPSAPI(.ABSP)              ; Call published 3PB API
  1.  ;D SETFLAG^ABSPOSBC(HOLD57,0) ; clear the "needs billing" flag
  1.  ;S HOLDDA=ABSPOST
  1.  ;Q
  1.  ;REVERSIT ;
  1.  ;N ABSP,ABSPWOFF,ABSCAN
  1.  ;S ABSP("CREDIT")=$P(HOLDREC,U,4)            ; $$ to reverse
  1.  ;S ABSP("ARLOC")=$P(HOLDREC,U,5)             ; A/R Bill location
  1.  ;S ABSP("TRAN TYPE")=$P(HOLDREC,U,6)         ; Adjustment
  1.  ;S ABSP("ADJ CAT")=$P(HOLDREC,U,7)           ; Write off
  1.  ;S ABSP("ADJ TYPE")=$P(HOLDREC,U,8)          ; Billed in error
  1.  ;S ABSP("USER")=$P(HOLDREC,U,9)              ; User who entered tran
  1.  ;
  1.  ;D LOG^ABSPOSL("Reversing transaction "_HOLD57_".")
  1.  ;S ABSPWOFF=$$EN^BARPSAPI(.ABSP)             ; Call published A/R API
  1.  ;S ABSCAN=$$CAN^ABMPSAPI(ABSPWOFF)           ; Cancel bill in 3PB
  1.  ;D SETFLAG^ABSPOSBC(HOLD57,0) ; clear the "needs billing" flag
  1.  ;S HOLDDA=ABSPWOFF
  1.  ;
  1.  ;Q
  1.  ;HOLDSCR ;EP - ABSPMHDR
  1.  ;
  1.  ;N HOLDCNT
  1.  ;S HOLDCNT=+$P($G(^ABSPHOLD(0)),U,4)
  1.  ;Q:HOLDCNT=0
  1.  ;N DASH
  1.  ;S $P(DASH,"*",61)=""
  1.  ;W @IOF
  1.  ;W !!!
  1.  ;W !,?10,DASH
  1.  ;W !,?10,"*",?69,"*"
  1.  ;W !,?10,"*"," There are ",HOLDCNT," POS Claims not being passed to 3PB",?69,"*"
  1.  ;W !,?10,"*"," due to missing tax id.",?69,"*"
  1.  ;W !,?10,"*",?69,"*"
  1.  ;W !,?10,"*"," Please run the following report for more information:",?69,"*"
  1.  ;W !,?10,"*",?69,"*"
  1.  ;W !,?10,"*","     HELD   Count of POS Claims not Passed to 3PB",?69,"*"
  1.  ;W !,?10,"*",?69,"*"
  1.  ;W !,?10,"*"," To run the report select options RPT/CLA/HELD.",?69,"*"
  1.  ;W !,?10,"*",?69,"*"
  1.  ;W !,?10,DASH
  1.  ;W !!!
  1.  ;D PRESSANY^ABSPOSU5()
  1.  ;Q
  1.  ; IHS/OIT/SCR 9/23/08 - Patch 28 END CHANGES