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

ABSPOSQC.m

Go to the documentation of this file. 
  1. ABSPOSQC ; IHS/FCS/DRS - POS background, Part 1 ;
  1.  ;;1.0;PHARMACY POINT OF SALE;;JUN 21, 2001
  1.  Q
  1.  ;  GETPHARM, GETDIV, VISIT subroutines
  1.  ;
  1. GETPHARM ;EP -  given ABSBPDIV, ABSBSDIV, ABSBRXI, ABSBRXR
  1.  S ABSPHARM=0 ; want to set this value
  1.  N SUB S SUB=$P("OPSITE^",U,ABSBSDIV) Q:SUB=""  ; which list to check
  1.  N X S X=0 F  S X=$O(^ABSP(9002313.56,X)) Q:'X  D  Q:ABSPHARM
  1.  . Q:'$D(^ABSP(9002313.56,X,SUB,"B",ABSBPDIV))
  1.  . N Y S Y=$O(^ABSP(9002313.56,X,SUB,"B",ABSBPDIV,0))
  1.  . ; this division might belong to this pharmacy
  1.  . ; if there's a providers list, you need to match on it, too
  1.  . ; (This is to handle the Sitka situation with Haines)
  1.  . I '$D(^ABSP(9002313.56,X,SUB,Y,1)) S ABSPHARM=X Q  ; none
  1.  . N PRESC S PRESC=$P(^PSRX(ABSBRXI,0),U,4) Q:'PRESC
  1.  . Q:'$D(^ABSP(9002313.56,X,SUB,Y,1,"B",PRESC))
  1.  . S ABSPHARM=X ; matched both division and prescriber
  1.  Q
  1. GETDIV ;EP - Var setup: Given ABSBRXI, ABSBRXR, Set ABSBPDIV, ABSBSDIV
  1.  S (ABSBSDIV,ABSBPDIV)=0 N X1,X
  1.  I ABSBRXR D  ; if refill, get the (PRESCRIPTION,REFILL DATE,DIVISION)
  1.  . S X=$P($G(^PSRX(ABSBRXI,1,ABSBRXR,0)),U,9)
  1.  E  I ABSBRXI D  ; if not refill, get the (PRESCRIPTION,DIVISION)
  1.  . S X=$P($G(^PSRX(ABSBRXI,2)),U,9)
  1.  E  Q  ; must be a supply item - no prescription file entry
  1.  ;       for supply item, leave division as 0, it's okay
  1.  S ABSBPDIV=X ;$P($G(^PS(59,ABSBPDIV,0)),U,6) points to institution
  1.  S ABSBSDIV=1 ; file 59 is where this points
  1.  ;   $P(^PS(59,ABSBPDIV,"INI"),U) points to related institution
  1.  I 'ABSBPDIV D  Q
  1.  .D LOG^ABSPOSL("DIVISION - Incorrect or missing for "_ABSBRXI_","_ABSBRXR) Q
  1.  ; and a lot of early ANMC complexity deleted
  1.  Q
  1. VISIT ;EP -  Var setup:  pointers ^AUPNVSIT(ABSBVISI and ^AUPNVMED(VMEDDFN
  1.  ; We assume that the visit is already created,
  1.  ; we assume that the prescription is already entered,
  1.  ; we assume that the PCC link is already created.
  1.  ; Isn't VMEDDFN required for us?  Or is the prescription # good enough?
  1.  ;  (have to look at claim assembly code to know for sure)
  1.  ; ANMC tally as of 03/10/2000 5:15PM EST:
  1.  ;   4675 found via PCC link;  0 found by date@12;  2 visits created
  1.  ; So we don't really need or want all that extra baggage, do we?
  1.  S ABSBVISI="",VMEDDFN=""
  1.  N X
  1. VIS1 ;get PCC link for last refill, if any; otherwise for first fill
  1.  N LINKSRC,PCCLINK,RESULT
  1.  ; Start by getting the appropriate PCC link
  1.  I ABSBRXR D
  1.  . S PCCLINK=$P($G(^PSRX(ABSBRXI,1,ABSBRXR,999999911)),U) ;refill
  1.  . S LINKSRC="#"_ABSBRXR
  1.  E  D
  1.  . S PCCLINK=$P($G(^PSRX(ABSBRXI,999999911)),U) ;first fill
  1.  . S LINKSRC="#0"
  1.  S RESULT="VISIT - PCC LINK "_LINKSRC_"->"
  1. VIS2 I PCCLINK D  ; yes, a PCC link was found
  1.  .S VMEDDFN=PCCLINK ; remember IEN into V MEDICATION
  1.  .S RESULT=RESULT_"^AUPNVMED("_VMEDDFN_"->"
  1.  .S ABSBVISI=$P($G(^AUPNVMED(VMEDDFN,0)),U,3)
  1.  .S RESULT=RESULT_"^AUPNVSIT("_ABSBVISI
  1.  I 'ABSBVISI S RESULT=RESULT_":FAILURE"
  1.  D LOG^ABSPOSL(RESULT)
  1.  D INCSTAT^ABSPOSUD("V",$S(ABSBVISI:1,1:2)) ; 1 success, 2 failure
  1.  Q
  1.  ; - - - - - - - - - - - - -