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

ABSPOSQB.m

Go to the documentation of this file. 
  1. ABSPOSQB ; IHS/FCS/DRS - POS background, Part 1 ;   [ 08/20/2002  9:01 AM ]
  1.  ;;1.0;PHARMACY POINT OF SALE;**1,3,23,46,48**;JUN 21, 2001;Build 38
  1.  ;
  1.  ;IHS/DSD/lwj 10/09/01 on behalf of David Slauenwhite - change 
  1.  ; consist of one line be altered in the "C" subroutine.
  1.  ; David reported:
  1.  ;   I think that what happens is that CLEAR59^ABSPOSIZ always 
  1.  ;   cleans out the 9002313.59 transaction-in-progress entry so 
  1.  ;   that C+3 always gets null for both these fields.  The
  1.  ;   GETDIV^ABSPOSQC computes them anew, and then C+7:C+8
  1.  ;   stores the computed values in the correct locations so that in 
  1.  ;   D+3, GETPHARM^ABSPOSQC will find the correct pharmacy.
  1.  ;
  1.  ;IHS/SD/lwj 08/20/01  NCPDP 5.1 changes
  1.  ; New field added to point to the new DUR/PPS values file.  The
  1.  ; pointer will reside in the Outpatient Pharmacy V6.0 file following
  1.  ; the release of Patch 4.  For now, we are just setting up the code
  1.  ; in anticipation of the field.  (PCS will require the DUR/PPS
  1.  ; claim segment as part of their format.)
  1.  ; Since the logic is similar to the Override field -I will add this
  1.  ; new field retrieval to the same place in the code.
  1.  ;
  1.  ;IHS/SD/RLT - 06/21/07 - 10/18/07 - Patch 23
  1.  ; Get DIAGNOSIS CODE POINTER from prescription file
  1.  ;
  1.  ;IHS/OIT/CAS/RCS - 08/12/13 - Patch 46
  1.  ; Create error message on Claim when there is no Division
  1.  Q
  1. CLAIMINF() ;EP - from ABSPOSQA
  1.  ; Send in ABSBRXI, ABSBRXR, ABSBNDC, IEN59
  1.  ; Fill in as much other information as possible,
  1.  ; Every 9002313.59 field must be accounted for in here!
  1.  ;  Even if only to say "not filled in", or to explicitly delete field. 
  1.  ;
  1.  N FN S FN=9002313.59
  1.  N FDA,IEN,MSG
  1.  N IEN59COM S IEN59COM=IEN59_","
  1.  ;
  1.  ; Now fill in missing information.
  1.  ; Set up FDA(FN,IEN59_",",FIELD)=internal value
  1.  ;
  1.  ; ***
  1.  ; ***  Fields in the ^(0) node
  1.  ; ***
  1.  ; .01 ENTRY#  already done
  1.  ; .13 TYPE    already done  ; use $$TYPE^ABSPOSQ to infer it from IEN59 in here
  1.  ; 1   STATUS  already done
  1.  ; 2   PCN     not yet
  1.  ; 3   CLAIM   not yet 
  1.  ; 4   RESPONSE  not yet
  1.  ;
  1.  ; 12  VISIT        -  set up ABSBVISI
  1.  ;
  1. A S ABSBVISI=$P(^ABSPT(IEN59,0),U,7)
  1.  I 'ABSBVISI D  ; need to lookup visit
  1.  . I $$TYPE^ABSPOSQ=3 D  ; if supply item, we found visit from ^PSRX
  1.  . . D IMPOSS^ABSPOSUE("DB,P","TI","Supply item must have visit by now.",IEN59,"A",$T(+0))
  1.  . D VISIT^ABSPOSQC
  1.  . S FDA(FN,IEN59COM,12)=ABSBVISI
  1.  I 'ABSBVISI Q 12 ; result code 12 - visit lookup failed
  1.  ;
  1.  ; Make sure there's a VCN number assigned to this visit
  1.  ;
  1. A1 I $$MAKEVCN^ABSPOSQ D SETVCN^ABSPOSQD
  1.  ;
  1.  ; 5   PATIENT      -  set up ABSBPATI
  1.  ;
  1. B S ABSBPATI=$P(^ABSPT(IEN59,0),U,6)
  1.  I 'ABSBPATI D
  1.  . S ABSBPATI=$P(^AUPNVSIT(ABSBVISI,0),U,5)
  1.  . S FDA(FN,IEN59COM,5)=ABSBPATI
  1.  ;
  1.  ; 7   LAST UPDATE  not here
  1.  ; 14  POSITION IN CLAIM  not here
  1.  ; 13  USER    already done
  1.  ; 15  START TIME  already done
  1.  ; 16  COMMS LOG    not yet
  1.  ;
  1.  ; ***
  1.  ; ***  Fields in the ^(1) node
  1.  ; ***
  1.  ; 9   ABSBRXR  already done
  1.  ; 10  ABSBNDC 
  1.  S FDA(FN,IEN59COM,10)=ABSBNDC ; usually already there
  1.  ;
  1.  ; 8   VCPT  - at the very end, in a separate billing job,
  1.  ;     in the billing programs, ABSPOSB* 
  1.  ;
  1.  ; 11  ABSBDIV           -  ABSBPDIV, pointer to ^PS(59,ABSBPDIV,*)
  1.  ; 1.05 ABSBDIV SOURCE   -  ABSBSDIV, source = 1
  1.  ;
  1. C S ABSBPDIV=$P(^ABSPT(IEN59,1),U,4)
  1.  I ABSBPDIV D
  1.  . N X S X=^ABSPT(IEN59,1)
  1.  . ;IHS/DSD/lwj 10/09/01 nxt line changed to line below
  1.  . ;S ABSBSDIV=$P(X,U,4),ABSBPDIV=$P(X,U,5)  ;IHS/DSD/lwj 10/09/01
  1.  . S ABSBPDIV=$P(X,U,4),ABSBSDIV=$P(X,U,5)   ;IHS/DSD/lwj 10/09/01
  1.  ; end of 10/09/01 changes
  1.  I 'ABSBPDIV D
  1.  . D GETDIV^ABSPOSQC ; needs ABSBRXI,ABSBRXR
  1.  . I $$TYPE^ABSPOSQ=1!($$TYPE^ABSPOSQ=2) D  ; prescription or postage
  1.  . . S FDA(FN,IEN59COM,11)=ABSBPDIV
  1.  . . S FDA(FN,IEN59COM,1.05)=ABSBSDIV
  1.  ;
  1.  ; 1.07 PHARMACY  (depends on ABSBSDIV,ABSBPDIV)
  1.  ;
  1. D S ABSPHARM=$P(^ABSPT(IEN59,1),U,7)
  1.  I 'ABSPHARM D
  1.  . D GETPHARM^ABSPOSQC
  1.  . S FDA(FN,IEN59COM,1.07)=ABSPHARM
  1.  I 'ABSPHARM Q 105 ; OIT/CAS/RCS 081313 Patch 46, result code 105 - pharmacy lookup failed
  1.  ;
  1.  ; 1.06 INSURER - see ^(6) and ^(7), below
  1.  ; 1.08 PINS PIECE - see ^(6) and ^(7), below
  1.  ;
  1.  ; 1.09 PREAUTHORIZATION NUMBER
  1.  ;  May someday need to do an extra lookup here.
  1.  ;  Thinking of Puyallup, where an extensive preauthorization number
  1.  ;  database scheme has been set up in the past.
  1.  ;  (And more typically, may be handled by the NCPDP OVERRIDE
  1.  ;
  1.  ; 1.11 ABSBRXI  already done
  1.  ;
  1.  ; 1.12 RESUBMIT AFTER REVERSAL
  1.  ;   How's that work again?  It was set by the caller, right?
  1.  ;
  1.  ; 1.13 NCPDP OVERRIDES
  1.  I $$TYPE^ABSPOSQ=1!($$TYPE^ABSPOSQ=2) D
  1.  . N ABSPRXI,ABSPRXR
  1.  . S ABSPRXI=$$RXI^ABSPOSQ
  1.  . S ABSPRXR=$$RXR^ABSPOSQ
  1.  . ;N X S X=$$GETIEN^ABSPOSO($$RXI^ABSPOSQ,$$RXR^ABSPOSQ)
  1.  . N X S X=$$GETIEN^ABSPOSO(ABSPRXI,ABSPRXR)
  1.  . I X S FDA(FN,IEN59COM,1.13)=X
  1.  . ;
  1.  . ;IHS/SD/lwj 8/20/02 NCPDP 5.1 changes - add the retrieval of the
  1.  . ; DUR/PPS pointer from the prescription file
  1.  . ;N DUR S DUR=$$GETDUR^ABSPOSO($$RXI^ABSPOSQ,$$RXR^ABSPOSQ)
  1.  . N DUR S DUR=$$GETDUR^ABSPOSO(ABSPRXI,ABSPRXR)
  1.  . I DUR S FDA(FN,IEN59COM,1.14)=DUR
  1.  . ;
  1.  . ;IHS/SD/RLT - 06/21/07 - 10/18/07 - Patch 23
  1.  . ; Get DIAGNOSIS CODE POINTER
  1.  . ;N DIAG S DIAG=$$GETDIAG^ABSPOSO($$RXI^ABSPOSQ,$$RXR^ABSPOSQ)
  1.  . N DIAG S DIAG=$$GETDIAG^ABSPOSO(ABSPRXI,ABSPRXR)
  1.  . I DIAG S FDA(FN,IEN59COM,1.17)=DIAG
  1.  ;
  1.  ; ***
  1.  ; ***   Fields in the ^(2) node - RESULT CODE, RESULT TEXT - not here
  1.  ; ***   In the ^(3) node - CANCELLATION REQUESTED - not here
  1.  ; ***   In the ^(4) node - REVERSAL CLAIM, REVERSAL RESPONSE - not here
  1.  ; ***
  1.  ;
  1.  ; ***
  1.  ; ***   INSURANCE data  
  1.  ; ***   Fields 1.06 INSURER and 1.08 PINS PIECE
  1.  ; ***   And the ^(6) and ^(7) nodes
  1.  ; ***
  1.  S INSURER=$P(^ABSPT(IEN59,1),U,6)
  1. I I INSURER D  ; whoever set up this entry included insurance data
  1.  . ; nothing more to do right now
  1.  E  D  ; insurance data not set up; establish defaults here and now
  1.  . N INSARRAY
  1.  . I $$TYPE^ABSPOSQ=2 D  ; postage: try to take same insur. as prescrip
  1.  . . N N57 S N57=$$N57LAST^ABSPOSQ() Q:'N57  ; last transaction
  1.  . . N TMP M TMP=^ABSPTL(N57) Q:'$D(TMP(6))
  1.  . . S INSARRAY(0)=$L(TMP(6),U)
  1.  . . N I F I=1:1:$L(TMP(6),U) D
  1.  . . . S INSARRAY(I)=$P(TMP(7),U,I)_U_$P(TMP(6),U,I)
  1.  . I '$D(INSARRAY) D INSURER^ABSPOS25(.INSARRAY)
  1.  . ; INSARRAY(0)=count^other junk...
  1.  . ; INSARRAY(n)=insurer^pins
  1.  . N I F I=1:1:$P(INSARRAY(0),U) D
  1.  . . I I>3 Q
  1.  . . S FDA(FN,IEN59COM,I+700)=$P(INSARRAY(I),U)
  1.  . . S FDA(FN,IEN59COM,I+600)=$P(INSARRAY(I),U,2)
  1.  . . I I=1 D
  1.  . . . S (INSURER,FDA(FN,IEN59COM,1.06))=$P(INSARRAY(I),U)
  1.  . . . S FDA(FN,IEN59COM,1.08)=1
  1.  ;
  1.  ; ***   Check to make sure Prescriber NPI is defined - it is now required
  1.  ;
  1. N N NPI D  I 'NPI Q 106 ; OIT/CAS/RCS 081913 Patch 46, result code 106 - prescriber NPI lookup failed
  1.  .N PROVIEN,ABSPRXI,XUSDATE
  1.  .S ABSPRXI=$$RXI^ABSPOSQ,PROVIEN=$P($G(^PSRX(ABSPRXI,0)),U,4),NPI=$P($$NPI^XUSNPI("Individual_ID",+PROVIEN),U)
  1.  ;
  1.  ; ***
  1.  ; ***   PRICING data - in the ^(5) node
  1.  ; ***
  1.  ; 
  1. P N PRICING S PRICING=$G(^ABSPT(IEN59,5))
  1.  I $P(PRICING,U,5)]"" D
  1.  . ; do nothing; pricing is already determined
  1.  E  D  ; need to figure out pricing
  1.  . I $$TYPE^ABSPOSQ=2 D
  1.  . . D IMPOSS^ABSPOSUE("DB,P","TI","Pricing of postage must already be in place by now.",IEN59,"P:2",$T(+0))
  1.  . E  I $$TYPE^ABSPOSQ=3 D
  1.  . . D IMPOSS^ABSPOSUE("DB,P","TI","Pricing of supplies must already be in place by now.",IEN59,"P:3",$T(+0))
  1.  . E  I $$TYPE^ABSPOSQ=1 D  ; Drug pricing:
  1.  . . N DRGDFN,DRGNAME,PROVDFN,PROV,PRICALC
  1.  . . N ABSBRXI,ABSBRXR,ABSBNDC,ABSBDRGI
  1.  . . S ABSBRXI=$$RXI^ABSPOSQ,ABSBRXR=$$RXR^ABSPOSQ,ABSBNDC=$$NDC^ABSPOSQ
  1.  . . S ABSBDRGI=$$DRGDFN^ABSPOSQ ; INSURER was set above
  1.  . . D EN^ABSPOSQP ; and PRICING is set for you
  1.  . N I F I=1:1:5 S FDA(FN,IEN59COM,I+500)=$P(PRICING,U,I)
  1.  ;
  1.  ; The 9002313.59 entry has all the data it should have at this point.
  1.  ; Store whatever data were just determined in this routine.
  1.  ;
  1. FILE1 I $D(FDA) D FILE^DIE("","FDA","MSG")  ; /IHS/OIT/RAM ; 12 JUN 17 ; REMOVED A CONFUSING "DOUBLE-DO" HERE.
  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 FILE99
  1.  . D LOG^ABSPOSL("Error in D FILE^DIE at tag FILE1^"_$T(+0))
  1.  . D LOGMSG ; failure - log returned diagnostics
  1.  ;
  1. FILE99 D LOG59 ; log a copy of what's in the IEN59 now
  1.  Q $S($D(MSG):1000,1:0) ; >0 if error, =0 if no error
  1.  ;
  1. LOGMSG D LOG^ABSPOSL("Error returned by FILE^DIE")
  1.  D LOGARRAY("MSG") Q  ; log the MSG array
  1. LOGARRAY(Q) ;EP - ABSPOSQD
  1.  I $D(@Q)#10 D LOG^ABSPOSL(Q_"="_@Q)
  1.  F  S Q=$Q(@Q) Q:Q=""  D LOG^ABSPOSL(Q_"="_@Q)
  1.  Q
  1. LOG59 ; log the IEN59 entry
  1.  N A M A=^ABSPT(IEN59)
  1.  D LOG^ABSPOSL("Contents of ^ABSPT("_IEN59_") :")
  1.  D LOGARRAY("A")
  1.  Q
  1. LOG59A ;EP - from REVERS59^ABSPOS6D
  1.  N SAVESLOT S SAVESLOT=$$GETSLOT^ABSPOSL
  1.  D SETSLOT^ABSPOSL(IEN59)
  1.  D LOG59
  1.  D RELSLOT^ABSPOSL
  1.  D SETSLOT^ABSPOSL(SAVESLOT)
  1.  Q