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

ABMPSAPI.m

Go to the documentation of this file. 
  1. ABMPSAPI ; IHS/ASDS/LSL - 3PB Pharmacy POS API   
  1.  ;;2.6;IHS Third Party Billing System;**2,4,6,10,21**;NOV 12, 2009;Build 379
  1.  ;
  1.  ; IHS/ASDS/LSL - 05/17/2001 - V2.4 Patch 6 - New routine to accomodate
  1.  ;     Pharmacy POS.  A somewhat generic API to accept info from
  1.  ;     Pharmacy POS to create a bill in Third Party Billing and
  1.  ;     therefore pass to Accounts Receivable.
  1.  ; IHS/ASDS/LWJ - 06/01/2001 - V2.4 Patch 5 - altered ^DIC call for the
  1.  ;     insurer to no longer access the special lookup routine AUTNKWII
  1.  ; IHS/ASDS/LSL - 06/14/2001 - V2.4 Patch 5 - Added CAN line tag to 
  1.  ;     mark POS bills as cancelled when reversed through POS.
  1.  ; IHS/ASDS/LSL - 07/18/01 - V2.4 Patch 8
  1.  ;     Resolve <DPARM>CAN+3^ABMPSAPI.
  1.  ; IHS/SD/SDR - v2.5 p9 - IM15457
  1.  ;    Use visit location for duz(2)
  1.  ; IHS/SD/SR - v2.5 p9 - IM18926
  1.  ;    Added capability to reprint in TPB on NCPDP format
  1.  ; IHS/SD/SDR - v2.5 p10 - IM21800
  1.  ;   Fix for <UNDEF>DBFX+10^ABMDEFIP
  1.  ; IHS/SDR/SDR - v.25 p12 - UFMS
  1.  ;   Changes to log POS claims for UFMS reporting/export
  1.  ; IHS/SD/SDR - v2.5 p12 - IM25440
  1.  ;   Changed default clinic to 39 (from 25)
  1.  ; IHS/SD/SDR - v2.5 p13 - IM26096
  1.  ;   Stop cashiering session creation for tribal sites
  1.  ;   and don't display warning message
  1.  ; IHS/SD/SDR - abm*2.6*4 - NO HEAT - populate INSURER TYPE
  1.  ; IHS/SD/SDR - abm*2.6*6 - NOHEAT - populate OTHER BILL IDENTIFER in 3P Bill file
  1.  ;IHS/SD/SDR - 2.6*21 - HEAT118656 - Made change to send back error if A/R Bill isn't found (if it was deleted)
  1.  ;
  1.  Q
  1.  ;
  1.  ; *********************************************************************
  1. EN(ABMPOS)         ; PEP
  1.  ; Pass array sub field number.  ie:  ARRAY(Field #)
  1.  ; If field is inside a 3P Bill multiple, array needs to be  
  1.  ; ARRAY(Mult #,field #)
  1.  ;
  1.  ; ABMPOS(.21)             Bill amount
  1.  ; ABMPOS(.23)             Gross amount
  1.  ; ABMPOS(.05)             Patient
  1.  ; ABMPOS(.71)             Service date from
  1.  ; ABMPOS(.72)             Service date to
  1.  ; ABMPOS(.1)              Clinic
  1.  ; ABMPOS(.03)             Visit location
  1.  ; ABMPOS(.08)             Active insurer
  1.  ; ABMPOS(.58)             Pro Authorization number
  1.  ; ABMPOS(.14)             Approving Official
  1.  ; ABMPOS(11,.01)          Visit IEN  ;abm*2.6*2
  1.  ; ABMPOS(41,.01)          Provider multiple, Provider
  1.  ; ABMPOS(23,.01)          Pharmacy multiple, Medication
  1.  ; ABMPOS(23,.03)          Pharmacy multiple, units
  1.  ; ABMPOS(23,.04)          Pharmacy multiple, unit cost
  1.  ; ABMPOS(23,.05)          Pharmacy multiple, dispense fee
  1.  ; ABMPOS(23,19)           Pharmacy multiple, new/refill code
  1.  ; ABMPOS(23,.06)          Pharmacy multiple, Prescription
  1.  ; ABMPOS(23,14)           Pharmacy multiple, Date filled
  1.  ; ABMPOS(23,20)           Pharmacy multiple, Days supply
  1.  ; ABMPOS(73,"REJDATE")    POS Rejection Date  ;abm*2.6*2
  1.  ; ABMPOS(73,CNTR,"CODE")  POS Rejection Code  ;abm*2.6*2
  1.  ; ABMPOS(73,CNTR,"REASON")POS Rejection Reason  ;abm*2.6*2
  1.  ; ABMPOS("OTHIDENT")      Other Bill Identifier for A/R
  1.  ;
  1.  ; First determine proper DUZ(2) (code borrowed from claim generator)
  1.  ; 2 assumptions: 1. Pharmacy and POS do not manipulate DUZ(2) variable
  1.  ;                2. DUZ(2) is always the parent (box user is on)
  1.  K ABMDUZ2,ABMARPS,ABMHOLD,ABMAPOK,ABMBILL,ABMFLD,ABMULT,ABMPASAR
  1.  K DINUM,DIC,DA,DIE,X,Y,DD,DO,DLAYGO
  1.  S ABMDUZ2=ABMPOS(.03)
  1.  S ABMARPS=$P($G(^ABMDPARM(DUZ(2),1,4)),U,9)    ; Use A/R parent/sat
  1.  ; Use A/R parent/sat is yes and visit location not defined under parent
  1.  ; in A/R Parent/Satellite file.
  1.  I ABMARPS,'$D(^BAR(90052.05,DUZ(2),ABMPOS(.03),0)) S ABMDUZ2=ABMPOS(.03)
  1.  ; Use A/R parent/sat is yes, but DUZ(2) is not the parent for this 
  1.  ; visit location
  1.  I ABMARPS,$P($G(^BAR(90052.05,DUZ(2),ABMPOS(.03),0)),U,3)'=DUZ(2) S ABMDUZ2=ABMPOS(.03)
  1.  I ABMARPS,$P($G(^BAR(90052.05,DUZ(2),ABMPOS(.03),0)),U,6)>ABMPOS(.71) S ABMDUZ2=ABMPOS(.03)
  1.  I ABMARPS,$P($G(^BAR(90052.05,DUZ(2),ABMPOS(.03),0)),U,7),$P(^(0),U,7)<ABMPOS(.71) S ABMDUZ2=ABMPOS(.03)
  1.  I '$D(^ABMDPARM(ABMDUZ2,0)) Q "Not in 3P Parameters"
  1.  S ABMHOLD=DUZ(2)                     ; Store DUZ(2)
  1.  S DUZ(2)=ABMDUZ2
  1.  ;
  1.  D NOW^%DTC
  1.  S ABMPOS(.15)=%                      ; Date/Time approved = now
  1.  S ABMPOS(.02)=131                    ; Bill type = outpatient
  1.  S ABMPOS(.06)=24                     ; export mode NCPDP
  1.  S ABMPOS(.07)=901                    ; Visit type = 901 (only POS)
  1.  S ABMPOS(13,.02)=1                   ; Insurer multiple, priority
  1.  S ABMPOS(13,.03)="I"                 ; Insurer multiple, status
  1.  S ABMPOS(41,.02)="A"                 ; Provider multiple, Attending
  1.  S ABMPOS(.1)=39    ; always Pharmacy clinic
  1.  ;
  1.  S ABMAPOK=1                          ; Pass 3PB to A/R
  1.  K DINUM,DIC
  1.  S DIC(0)="LX"
  1.  S DIC="^ABMDBILL(DUZ(2),"
  1.  S X=$$NXNM^ABMDUTL                   ; Get next Claim number
  1.  I 'X S DUZ(2)=ABMHOLD Q "Next claim number unsuccessful"
  1.  S X=X_"A"                            ; Bill number
  1.  K DD,DO,DA
  1.  S DLAYGO=9002274.4
  1.  D ^DIC
  1.  I +Y<0 S DUZ(2)=ABMHOLD Q "3P Bill create unsuccessful"  ; Bill addition unsuccessful
  1.  S (DA,ABMBILL)=+Y
  1.  S DIE=DIC
  1.  S ABMFLD=0
  1.  F  S ABMFLD=$O(ABMPOS(ABMFLD)) Q:'+ABMFLD  D
  1.  .Q:ABMFLD>1
  1.  .Q:ABMPOS(ABMFLD)=""
  1.  .S DR=ABMFLD_"////"_ABMPOS(ABMFLD)
  1.  .D ^DIE
  1.  ;start new code abm*2.6*4 NOHEAT
  1.  ;S DR=".22////"_$P($G(^AUTNINS(ABMPOS(.08),2)),U)  ;abm*2.6*10 HEAT73780
  1.  S DR=".22////"_$$GET1^DIQ(9999999.181,$$GET1^DIQ(9999999.18,ABMPOS(.08),".211","I"),1,"I")  ;abm*2.6*10 HEAT73780
  1.  D ^DIE
  1.  ;end new code abm*2.6*4 NOHEAT
  1.  ;start new code abm*2.6*6 NOHEAT
  1.  S DR=".115////"_ABMPOS("OTHIDENT")
  1.  D ^DIE
  1.  ;end new code abm*2.6*6 NOHEAT
  1.  F ABMULT=13,23,41 D
  1.  .K DINUM,DIC,DA
  1.  .S DA(1)=ABMBILL
  1.  .S DIC("P")=$P(^DD(9002274.4,ABMULT,0),U,2)
  1.  .S DIC="^ABMDBILL(DUZ(2),"_DA(1)_","_ABMULT_","
  1.  .S DIC(0)="LXIE"
  1.  .S X=$S(ABMULT=13:$P(^AUTNINS(INSDFN,0),U),ABMULT=23:$P(^PSDRUG(ABMPOS(23,.01),0),U),1:$P(^VA(200,ABMPOS(41,.01),0),U))
  1.  .S DLAYGO=9002274.4
  1.  .K DD,DO
  1.  .D ^DIC
  1.  .I +Y<0 Q                           ; Addition of multiple unsuccess
  1.  .S DA=+Y
  1.  .S DIE=DIC
  1.  .S ABMFLD=.01
  1.  .F  S ABMFLD=$O(ABMPOS(ABMULT,ABMFLD)) Q:'+ABMFLD  D
  1.  ..Q:ABMPOS(ABMULT,ABMFLD)=""
  1.  ..S DR=ABMFLD_"////"_ABMPOS(ABMULT,ABMFLD)
  1.  ..D ^DIE
  1.  ;start new code abm*2.6*2
  1.  ; abm*2.6*2 this section was taken out because it stops other claims from generating.
  1.  ; Visits are being merged and with this code change, it stops claims from creating that should.
  1.  ; Needs to be reviewed, further tested, and included in a future patch of ABM.
  1.  ;K DINUM,DIC,DA,DIE,DR,DIE
  1.  ;S DA(1)=ABMBILL
  1.  ;S DIC("P")=$P(^DD(9002274.4,11,0),U,2)
  1.  ;S DIC="^ABMDBILL(DUZ(2),"_DA(1)_",11,"
  1.  ;S DIC(0)="LE"
  1.  ;S X=$G(ABMPOS(11,.01))
  1.  ;S DLAYGO=9002274.4
  1.  ;S DIC("DR")=".02////P"
  1.  ;K DD,DO
  1.  ;D FILE^DICN
  1.  ;
  1.  K DIC,DIE,DIR,X,Y,DA,DR
  1.  I $D(ABMPOS(73)) D  ;rejection codes/reasons
  1.  .S ABMCNT=0
  1.  .F  S ABMCNT=$O(ABMPOS(73,ABMCNT)) Q:(+$G(ABMCNT)=0)  D
  1.  ..K DIC,DIE,DIR,DA,DR,X,Y
  1.  ..S DA(1)=ABMBILL
  1.  ..S DIC="^ABMDBILL(DUZ(2),"_DA(1)_",73,"
  1.  ..S DIC(0)="LE"
  1.  ..S DIC("P")=$P(^DD(9002274.4,73,0),U,2)
  1.  ..S X=$G(ABMPOS(73,ABMCNT,"CODE"))
  1.  ..S DIC("DR")=".02////"_$G(ABMPOS(73,ABMCNT,"REASON"))_";.03////"_$G(ABMPOS(73,"REJDATE"))
  1.  ..K DD,DO
  1.  ..D ^DIC
  1.  ;end new code abm*2.6*2
  1.  ; This DIE call needs to be done last.  It's the x-ref on this field
  1.  ; that creates the bill in A/R from 3PB. It also defines the A/R
  1.  ; location field on the 3P bill [DUZ(2),DA].
  1.  K DIE,DA,DR
  1.  S DIE="^ABMDBILL(DUZ(2),"
  1.  S DA=ABMBILL
  1.  S DR=".04////B"                      ; Set bill status to B
  1.  D ^DIE
  1.  S ABMPASAR=$P($G(^ABMDBILL(DUZ(2),ABMBILL,2)),U,6)
  1.  I $P($G(^ABMDPARM(DUZ(2),1,4)),U,15)=1 D POSUFMS  ;create/populate UFMS Cashiering session
  1.  S DUZ(2)=ABMHOLD                     ; Restore DUZ(2) 
  1.  K ABMDUZ2,ABMARPS,ABMHOLD,ABMAPOK,ABMBILL,ABMFLD,ABMULT,ABMPOS
  1.  K DINUM,DIC,DA,DIE,X,Y,DD,DO,DLAYGO
  1.  I ABMPASAR="" Q "A/R Bill population unsuccessful"
  1.  Q ABMPASAR                          ; A/R DUZ(2),IEN
  1.  ;
  1.  ; *********************************************************************
  1. POSUFMS ; create/populate UFMS Cashiering Session
  1.  ;location
  1.  K ABMP("LDFN")
  1.  S ABMLOC=$$FINDLOC^ABMUCUTL
  1.  K DIC,DIE,X,Y,DA
  1.  S DIC="^ABMUCASH("
  1.  S DIC(0)="LMN"
  1.  S (X,DINUM)="`"_ABMLOC
  1.  D ^DIC
  1.  I Y<0 Q
  1.  S ABMLOC=+Y
  1.  ;
  1.  ;user
  1.  K DIC,DIE,X,Y,DA
  1.  S DA(1)=ABMLOC
  1.  S DIC="^ABMUCASH(DA(1),20,"
  1.  S DIC(0)="LMN"
  1.  S DIC("P")=$P(^DD(9002274.45,".03",0),U,2)
  1.  S (X,DINUM)=1
  1.  D ^DIC
  1.  I Y<0 Q
  1.  S ABMUSER=+Y
  1.  ;
  1.  ;sign in date
  1.  ;check for existing open session
  1.  I $D(^ABMUCASH(ABMLOC,20,1,20,0)) D
  1.  .S ABMSDT=999999999
  1.  .S ABMSFLG=0
  1.  .F  S ABMSDT=$O(^ABMUCASH(ABMLOC,20,1,20,ABMSDT),-1) Q:+ABMSDT=0  D  Q:ABMSFLG=1
  1.  ..Q:($P($G(^ABMUCASH(ABMLOC,20,1,20,ABMSDT,0)),U,4)'="O")
  1.  ..S ABMSFLG=1
  1.  I +$G(ABMSDT)=0 D
  1.  .K DIC,DIE,X,Y,DA
  1.  .S DA(2)=ABMLOC
  1.  .S DA(1)=ABMUSER
  1.  .S DIC="^ABMUCASH("_DA(2)_",20,"_DA(1)_",20,"
  1.  .S X="NOW"
  1.  .S DIC(0)="LMO"
  1.  .S DIC("P")=$P(^DD(9002274.4503,".02",0),U,2)
  1.  .S DIC("DR")=".04////O"
  1.  .D ^DIC
  1.  .Q:Y<0
  1.  .S ABMSDT=+Y
  1.  ;
  1.  ;insurer type
  1.  K DIC,DIE,X,Y,DA
  1.  S DA(3)=ABMLOC
  1.  S DA(2)=ABMUSER
  1.  S DA(1)=ABMSDT
  1.  S DIC="^ABMUCASH("_DA(3)_",20,"_DA(2)_",20,"_DA(1)_",11,"
  1.  ;S DIC(0)="LM"  ;abm*2.6*6 HEAT28427
  1.  S DIC(0)="LMX"  ;abm*2.6*6 HEAT28427
  1.  S DIC("P")=$P(^DD(9002274.45302,11,0),U,2)
  1.  ;S X=$P($G(^AUTNINS($P($G(^ABMDBILL(DUZ(2),ABMBILL,0)),U,8),2)),U)  ;abm*2.6*10 HEAT73780
  1.  S X=$$GET1^DIQ(9999999.181,$$GET1^DIQ(9999999.18,$P($G(^ABMDBILL(DUZ(2),ABMBILL,0)),U,8),".211","I"),1,"I")  ;abm*2.6*10 HEAT73780
  1.  S ABMP("INS")=$P($G(^ABMDBILL(DUZ(2),ABMBILL,0)),U,8)
  1.  D ^DIC
  1.  I +Y<0 W !,"NO ENTRY IN CASHIERING SESSION MADE",! H 2 Q
  1.  S ABMBA=+Y
  1.  ;
  1.  ;bill entry
  1.  K DIC,DIE,X,Y,DA
  1.  S DA(4)=ABMLOC
  1.  S DA(3)=ABMUSER
  1.  S DA(2)=ABMSDT
  1.  S DA(1)=ABMBA
  1.  S DIC="^ABMUCASH("_DA(4)_",20,"_DA(3)_",20,"_DA(2)_",11,"_DA(1)_",2,"
  1.  S X=$P($G(^ABMDBILL(DUZ(2),ABMBILL,0)),U)
  1.  S DIC(0)="LMO"
  1.  S DIC("P")=$P(^DD(9002274.4530211,".02",0),U,2)
  1.  S DIC("DR")=".02////"_DUZ(2)_";.03////"_ABMBILL
  1.  D ^DIC
  1.  Q
  1.  ; *********************************************************************
  1. CAN(ABM,ABM2) ;
  1.  ; For bills that reversed through Pharmacy POS, mark them as cancelled.
  1.  ; Using bill location in A/R, find it in 3PB
  1.  I '$G(ABM) Q ABM                     ; Don't know bill location
  1.  S ABMDUZ2=$P(ABM,",")
  1.  S ABMAR=$P(ABM,",",2)
  1.  I ('+ABMDUZ2!('+ABMAR)) Q "Not valid a/r bill location"
  1.  S ABMHOLD=DUZ(2)
  1.  S DUZ(2)=ABMDUZ2
  1.  S ABMBILL=$$GET1^DIQ(90050.01,ABMAR,.01)
  1.  I ABMBILL="" Q "No A/R Bill found"  ;no A/R bill  ;abm*2.6*21 IHS/SD/SDR HEAT118656
  1.  S ABMBILL=$P(ABMBILL,"-")
  1.  S DUZ(2)=$P($G(^BARBL(ABMDUZ2,ABMAR,0)),U,22)           ; 3P DUZ(2)
  1.  S:DUZ(2)="" DUZ(2)=$P($G(^BARBL(ABMDUZ2,ABMAR,1)),U,8)  ; visit loc
  1.  S DIC="^ABMDBILL(DUZ(2),"
  1.  S DIC(0)="XM"
  1.  S X=ABMBILL
  1.  D ^DIC
  1.  I Y'>0 D
  1.  .S DUZ(2)=$P($G(^BARBL(ABMDUZ2,ABMAR,0)),U,8)          ; Parent
  1.  .D ^DIC
  1.  I Y'>0 Q "3P bill not found"
  1.  S (DA,ABMDA)=+Y
  1.  ;
  1.  ; Bill found, so mark as cancelled.
  1.  K DR,DIE,DIC,X,Y
  1.  S DR=".04////X"
  1.  S DIE="^ABMDBILL(DUZ(2),"
  1.  D ^DIE
  1.  I $P($G(^ABMDPARM(DUZ(2),1,4)),U,15)=1 D CPOSUFMS  ;create/populate UFMS Cashiering session
  1.  Q "3P bill "_DUZ(2)_","_ABMDA_" cancelled"
  1. CPOSUFMS ; create/populate UFMS Cashiering Session
  1.  ;location
  1.  K ABMP("LDFN")
  1.  S ABMLOC=$$FINDLOC^ABMUCUTL
  1.  K DIC,DIE,X,Y,DA
  1.  S DIC="^ABMUCASH("
  1.  S DIC(0)="LMN"
  1.  S (X,DINUM)="`"_ABMLOC
  1.  D ^DIC
  1.  I Y<0 Q
  1.  S ABMLOC=+Y
  1.  ;
  1.  ;user
  1.  K DIC,DIE,X,Y,DA
  1.  S DA(1)=ABMLOC
  1.  S DIC="^ABMUCASH(DA(1),20,"
  1.  S DIC(0)="LMN"
  1.  S DIC("P")=$P(^DD(9002274.45,".03",0),U,2)
  1.  S (X,DINUM)=1
  1.  D ^DIC
  1.  I Y<0 Q
  1.  S ABMUSER=+Y
  1.  ;
  1.  ;sign in date
  1.  ;check for existing open session
  1.  I $D(^ABMUCASH(ABMLOC,20,1,20,0)) D
  1.  .S ABMSDT=999999999
  1.  .S ABMSFLG=0
  1.  .F  S ABMSDT=$O(^ABMUCASH(ABMLOC,20,1,20,ABMSDT),-1) Q:+ABMSDT=0  D  Q:ABMSFLG=1
  1.  ..Q:($P($G(^ABMUCASH(ABMLOC,20,1,20,ABMSDT,0)),U,4)'="O")
  1.  ..S ABMSFLG=1
  1.  I +$G(ABMSDT)=0 D
  1.  .K DIC,DIE,X,Y,DA
  1.  .S DA(2)=ABMLOC
  1.  .S DA(1)=ABMUSER
  1.  .S DIC="^ABMUCASH("_DA(2)_",20,"_DA(1)_",20,"
  1.  .S X="NOW"
  1.  .S DIC(0)="LMO"
  1.  .S DIC("P")=$P(^DD(9002274.4503,".02",0),U,2)
  1.  .S DIC("DR")=".04////O"
  1.  .D ^DIC
  1.  .Q:Y<0
  1.  .S ABMSDT=+Y
  1.  ;
  1.  ;insurer type
  1.  K DIC,DIE,X,Y,DA
  1.  S DA(3)=ABMLOC
  1.  S DA(2)=ABMUSER
  1.  S DA(1)=ABMSDT
  1.  S DIC="^ABMUCASH("_DA(3)_",20,"_DA(2)_",20,"_DA(1)_",11,"
  1.  S DIC(0)="LM"
  1.  S DIC("P")=$P(^DD(9002274.45302,11,0),U,2)
  1.  ;S X=$P($G(^AUTNINS($P($G(^ABMDBILL(DUZ(2),ABMDA,0)),U,8),2)),U)  ;abm*2.6*10 HEAT73780
  1.  S X=$$GET1^DIQ(9999999.181,$$GET1^DIQ(9999999.18,$P($G(^ABMDBILL(DUZ(2),ABMDA,0)),U,8),".211","I"),1,"I")  ;abm*2.6*10 HEAT73780
  1.  S ABMP("INS")=$P($G(^ABMDBILL(DUZ(2),ABMDA,0)),U,8)
  1.  D ^DIC
  1.  I +Y<0 W !,"NO ENTRY IN CASHIERING SESSION MADE",! H 2 Q
  1.  S ABMBA=+Y
  1.  ;
  1.  ;bill entry
  1.  K DIC,DIE,X,Y,DA
  1.  S DA(4)=ABMLOC
  1.  S DA(3)=ABMUSER
  1.  S DA(2)=ABMSDT
  1.  S DA(1)=ABMBA
  1.  S DIC="^ABMUCASH("_DA(4)_",20,"_DA(3)_",20,"_DA(2)_",11,"_DA(1)_",3,"
  1.  S X=$P($G(^ABMDBILL(DUZ(2),ABMDA,0)),U)
  1.  S DIC(0)="LMO"
  1.  S DIC("P")=$P(^DD(9002274.45302112,".03",0),U,2)
  1.  S DIC("DR")=".02////"_DUZ(2)_";.03////"_ABMDA
  1.  D ^DIC
  1.  Q