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

ABSPOSN2.m

Go to the documentation of this file. 
  1. ABSPOSN2 ; IHS/FCS/DRS - NCPDP Fms F ILC A/R ;  [ 09/12/2002  10:16 AM ]
  1.  ;;1.0;PHARMACY POINT OF SALE;**3**;JUN 21, 2001;Build 38
  1.  ;----------------------------------------------------------------------
  1.  ;----------------------------------------------------------------------
  1. PBITEM(BITEMIEN) ;EP
  1.  ;Manage local variables
  1.  N PATIEN,LITEMIEN,VSTIEN,IADTINS,IADTTYP,INSDATA,VMEDS,SVMEDS,DATEW
  1.  N NMEDS,NFORMS,INDEX,START,END,PATINFO,INSINFO,PHARINFO,DRUGINFO
  1.  N INSTYPE
  1.  N PCNDFN S PCNDFN=BITEMIEN
  1.  ;
  1.  ;Make sure input variables are defined
  1.  Q:$G(BITEMIEN)=""
  1.  Q:'$D(^ABSBITMS(9002302,BITEMIEN,0))
  1.  ;
  1.  S PATIEN=$P($G(^ABSBITMS(9002302,BITEMIEN,0)),U,2)
  1.  Q:PATIEN=""
  1.  Q:'$D(^DPT(PATIEN,0))
  1.  ;
  1.  S LITEMIEN=$O(^ABSBITMS(9002302,BITEMIEN,1,0))
  1.  Q:'+LITEMIEN
  1.  ;
  1.  S VSTIEN=$P($G(^ABSBITMS(9002302,BITEMIEN,1,LITEMIEN,0)),U,3)
  1.  Q:VSTIEN=""
  1.  Q:'$D(^AUPNVSIT(VSTIEN,0))
  1.  ;
  1.  S DIPA("VCN")=$P($G(^ABSBITMS(9002302,BITEMIEN,"VCN")),U,1)
  1.  ;
  1.  ; INSurance: S IADTINS,IADTTYP,INSDATA,INSTYPE
  1.  ;      
  1.  S IADTINS=$P($G(^ABSBITMS(9002302,BITEMIEN,0)),U,4)
  1.  I 'IADTINS S IADTINS=1 ; DRS; 04/13/2000
  1.  I $D(^ABSBITMS(9002302,BITEMIEN,"INSCOV1")) D
  1.  . K IADTTYPE ; no longer applicable
  1.  . M INSDATA=^ABSBITMS(9002302,BITEMIEN,"INSCOV1",IADTINS)
  1.  . S INSTYPE="INSCOV1"
  1.  E  D  ; Old INSCOV data structures
  1.  . S IADTTYP=$O(^ABSBITMS(9002302,BITEMIEN,"INSCOV",IADTINS,""))
  1.  . ;Q:IADTTYP'="PRVT"
  1.  . ;added INSNXT stuff to get past private INS only
  1.  . N INSNXT
  1.  . S INSNXT=$O(^ABSBITMS(9002302,BITEMIEN,"INSCOV",IADTINS,""))
  1.  . Q:INSNXT=""
  1.  . S INSDATA=$G(^ABSBITMS(9002302,BITEMIEN,"INSCOV",IADTINS,INSNXT,0))
  1.  . S INSTYPE=INSNXT ;="PRVT" or "CAID" or...
  1.  . ; what INSDATA means depENDs on INSTYPE
  1.  ;
  1.  D GETVMED(BITEMIEN,.VMEDS)
  1.  Q:+$G(VMEDS(0))=0
  1.  ;I BITEMIEN=130417,+$H=58185 U $P ZW VMEDS R ">>>",%
  1.  ;Get PATient, INSurer, and PHARmacy inFmation
  1.  D PATINFO^ABSPOSN3(PATIEN,.PATINFO)
  1.  D INSINFO^ABSPOSN3(.INSDATA,.INSINFO,INSTYPE)
  1.  D PHARINFO^ABSPOSN3(.PHARINFO,$P(VMEDS(1),U,6))
  1.  ;
  1.  ;Sort V Medications by DATE RX Written
  1.  D SORTVMED(.VMEDS,.SVMEDS)
  1.  ;I BITEMIEN=130417,+$H=58185 U $P ZW SVMEDS R ">>>",%
  1.  Q:'$D(SVMEDS)
  1.  U IO
  1.  S DATEW=0
  1.  F  D  Q:'+DATEW
  1.  .S DATEW=$O(SVMEDS(DATEW))
  1.  .Q:'+DATEW
  1.  .S NMEDS=+$G(SVMEDS(DATEW,0))
  1.  .Q:NMEDS=0
  1.  .S NFORMS=((NMEDS-1)\2)+1
  1.  .F INDEX=1:1:NFORMS D
  1.  ..S START=((INDEX-1)*2)+1
  1.  ..S END=START+2-1
  1.  ..S:END>NMEDS END=NMEDS
  1.  ..K DRUGINFO
  1.  ..S DRUGINFO(0)=$S(START=END:1,1:2)
  1.  ..;D DRUGINFO^ABSPOSN3(VMEDS(START),1,.DRUGINFO)
  1.  ..;D:'(START=END) DRUGINFO^ABSPOSN3(VMEDS(END),2,.DRUGINFO)
  1.  ..D DRUGINFO^ABSPOSN3(VMEDS(SVMEDS(DATEW,START)),1,.DRUGINFO)
  1.  ..D:START'=END DRUGINFO^ABSPOSN3(VMEDS(SVMEDS(DATEW,END)),2,.DRUGINFO)
  1.  ..D PFM^ABSPOSN6
  1.  Q
  1.  ;----------------------------------------------------------------------
  1.  ;Given a Billing ITEMs Record IEN number, this routine loops through
  1.  ;the V CPT multiple and returns all V Medication ITEMs.
  1.  ;
  1.  ;Parameters:  BITEMIEN  - Billing ITEMs IEN (9002302)
  1.  ;            .VMEDS     - Array of V Medication IEN #s (9000010.14)
  1.  ;                         VMEDS(0) = <Total Number>
  1.  ;                         VMEDS(N) = <V Medication IEN>
  1.  ;----------------------------------------------------------------------
  1. GETVMED(BITEMIEN,VMEDS) ;
  1.  ;Manage local variables
  1.  N NEXT,COUNT,VCPTIEN,RXIEN,RXRFIEN,VMEDIEN,RXWDATE,F57IEN
  1.  ;
  1.  ;Make sure input varaibles are defined
  1.  Q:$G(BITEMIEN)=""
  1.  Q:'$D(^ABSBITMS(9002302,BITEMIEN,0))
  1.  ;
  1.  S (NEXT,COUNT)=0
  1.  F  D  Q:'+NEXT
  1.  .S NEXT=$O(^ABSBITMS(9002302,BITEMIEN,"VCPT",NEXT))
  1.  .Q:'+NEXT
  1.  .;
  1.  .S VCPTIEN=$P($G(^ABSBITMS(9002302,BITEMIEN,"VCPT",NEXT,0)),U,1)
  1.  .Q:VCPTIEN=""
  1.  .Q:'$D(^ABSVCPT(9002301,VCPTIEN,0))
  1.  .;
  1.  .;
  1.  .S VMEDIEN=$P($G(^ABSVCPT(9002301,VCPTIEN,"SPEC")),U,2)
  1.  .S RXIEN=$P($G(^ABSVCPT(9002301,VCPTIEN,"SPEC")),U,1) ;12.29.99
  1.  .S F57IEN=$P($G(^ABSVCPT(9002301,VCPTIEN,"SPEC")),U,4) ;04/20/2000
  1.  .I F57IEN S RXRFIEN=$P($G(^ABSPTL(F57IEN,1)),U)
  1.  .I RXIEN,'VMEDIEN S VMEDIEN=$P($G(^PSRX(RXIEN,999999911)),U,1)
  1.  .;
  1.  .I VMEDIEN=""&('RXIEN) D  Q
  1.  . . S VDATE=$P($G(^ABSVCPT(9002301,VCPTIEN,"BATCH")),U,7)
  1.  . . S COUNT=COUNT+1
  1.  . . S $P(VMEDS(COUNT),U,5)=VCPTIEN
  1.  . . S $P(VMEDS(COUNT),U,4)=VDATE
  1.  . . S VMEDS(0)=COUNT
  1.  .;
  1.  .;Q:'$D(^AUPNVMED(VMEDIEN,0))
  1.  .;
  1.  .I VMEDIEN&('RXIEN) D
  1.  . . S RXIEN=$O(^PSRX("APCC",VMEDIEN,""))
  1.  . . Q:RXIEN=""
  1.  .I VMEDIEN,RXIEN,'$G(RXRFIEN) S RXRFIEN=$O(^PSRX("APCC",VMEDIEN,RXIEN,""))
  1.  .;
  1.  .Q:'RXIEN
  1.  .Q:'$D(^PSRX(RXIEN,0))
  1.  .;
  1.  .;Determine RX Written DATE
  1.  .S RXWDATE=$P($G(^PSRX(RXIEN,0)),U,13)
  1.  .;Q:RXWDATE=""
  1.  .S RXWDATE=$S(RXWDATE'="":RXWDATE,1:VDATE)
  1.  .S COUNT=COUNT+1
  1.  .S VMEDS(COUNT)=$G(VMEDIEN)_U_$G(RXIEN)_U_$G(RXRFIEN)_U_RXWDATE_U_VCPTIEN_U_F57IEN
  1.  ;
  1.  S VMEDS(0)=COUNT
  1.  Q
  1.  ;---------------------------------------------------------------------
  1. SORTVMED(VMEDS,SVMEDS) ;
  1.  ;Manage local varables
  1.  N INDEX,DATE
  1.  ;
  1.  Q:$G(VMEDS(0))=""
  1.  ;
  1.  F INDEX=1:1:VMEDS(0) D
  1.  .S DATE=$P($G(VMEDS(INDEX)),U,4)
  1.  .Q:DATE=""
  1.  .S SVMEDS(DATE,0)=$G(SVMEDS(DATE,0))+1
  1.  .S SVMEDS(DATE,SVMEDS(DATE,0))=INDEX
  1.  Q