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

ABSPOSCA.m

Go to the documentation of this file. 
  1. ABSPOSCA ; IHS/FCS/DRS - Create 9002313.02 entries ; 
  1.  ;;1.0;PHARMACY POINT OF SALE;;JUN 21, 2001
  1.  ;
  1.  ; Create 9002313.02 entries for RXILIST(*) claims.
  1.  ; Called from PACKET^ABSPOSQG
  1.  ;
  1.  ; Input:
  1.  ;      RXILIST(IEN59)  array of pointers to 9002313.59
  1.  ;         A list of prescriptions for the same visit/patient/etc.
  1.  ;         to be bundled into one or more 9002313.02 claims
  1.  ;
  1.  ; Outputs:
  1.  ;      CLAIMIEN(CLAIMIEN)="", pointers to the ^ABSPC(CLAIMIEN,
  1.  ;                             claim records created.
  1.  ;      ERROR
  1.  ;
  1.  ; ABSPOSCA calls:
  1.  ;   ABSPOSCB to build ABSP(*) array
  1.  ;      (and ABSPOSCB calls ABSPOSCC)
  1.  ;   ABSPOSCD to build the ^ABSPC( entry
  1.  ;
  1. EN(DIALOUT)        ;EP - from ABSPOSQG
  1.  I $D(RXILIST)<10 D IMPOSS^ABSPOSUE("P","TI","bad RXILIST",,,$T(+0))
  1.  ;Manage local variables
  1.  N ABSP,START,END,TOTAL,NCLAIMS,CLAIMN
  1.  S ERROR=$$ABSP^ABSPOSCB(DIALOUT,.ABSP)
  1.  I ERROR D LOG2LIST^ABSPOSQ($T(+0)_" - $$ABSP^ABSPOSCB("_DIALOUT_",.ABSP) returned "_ERROR)
  1.  I $G(ABSP("RX",0))="" S:'ERROR ERROR=301 Q
  1.  I $G(ABSP("NCPDP","# Meds/Claim"))="" S ERROR=302 Q
  1.  ;
  1.  ; Override any ABSP() nodes that you need to override.
  1.  ;
  1.  D  ; NDC #s - Translate POSTAGE (may be insurer-dependent someday)
  1.  .N N F N=1:1:ABSP("RX",0) D
  1.  ..N X,Y S X=$TR(ABSP("RX",N,"NDC"),"-",""),Y=ABSP("RX",N,"IEN59")
  1.  ..N Z S Z=$P(^ABSPT(Y,1),U,2)
  1.  ..I Z="POSTAGE" S Z=99999999981 ; 06/21/2000
  1.  ..; This next part should never happen; it should already be correct
  1.  ..;    ABSPOSQ1 already put the correct NDC # into the ^PSRX
  1.  ..;    and ABSPOSCE will pick it out from there.
  1.  ..I X'=Z,Z'="POSTAGE",Z'="" D  ; $TR inserted above, 03/07/2000
  1.  ...S ABSP("RX",N,"NDC")=Z
  1.  ...D LOG59^ABSPOSQ("CLAIM - NDC # on `"_Y_" sent as "_Z_", not "_X,Y)
  1.  ;
  1.  ;Calculate number of claim records to be generated for Billing Item
  1.  S NCLAIMS=((ABSP("RX",0)-1)\ABSP("NCPDP","# Meds/Claim"))+1
  1.  I NCLAIMS=0 S ERROR=303 Q
  1.  ;
  1.  ;Generate claim submission records
  1.  F CLAIMN=1:1:NCLAIMS D  Q:$G(ERROR)
  1.  .S START=((CLAIMN-1)*ABSP("NCPDP","# Meds/Claim"))+1
  1.  .S END=START+ABSP("NCPDP","# Meds/Claim")-1
  1.  .S:END>ABSP("RX",0) END=ABSP("RX",0)
  1.  .S TOTAL=END-START+1
  1.  .D NEWCLAIM^ABSPOSCE(START,END,TOTAL)
  1.  .S CLAIMIEN=ABSP(9002313.02)
  1.  .S CLAIMIEN(CLAIMIEN)=""
  1.  .; Mark each of the .59s with the claim number and position within
  1.  .F I=START:1:END D
  1.  ..;IEN59 handling 06/23/2000. The ELSE should never happen again.
  1.  ..; and the $G() can probably be gotten rid of, safely.
  1.  ..N IEN59 S IEN59=$G(ABSP("RX",I,"IEN59"))
  1.  ..I IEN59 D
  1.  ...N DIE,DA,DR S DIE=9002313.59
  1.  ...; Field (#3) CLAIM (#14) POSITION
  1.  ...S DA=IEN59,DR=3_"////"_CLAIMIEN_";14////"_I N I D ^DIE
  1.  ..E  D
  1.  ...S $P(^ABSPT(ABSP("RX",I,"RX IEN"),0),"^",4)=CLAIMIEN
  1.  ...S ^ABSPT("AE",CLAIMIEN,ABSP("RX",I,"RX IEN"))=""
  1.  ...S $P(^ABSPT(ABSP("RX",I,"RX IEN"),0),"^",9)=I
  1.  ..; POSITION:  Not the relative position within the packet,
  1.  ..; but the index in ABSP("RX",n,....  This is the position in which
  1.  ..; it will be stored in ^ABSPC(ien,400,POSITION
  1.  ..; and likewise for 9002313.03 when the response comes in.
  1.  Q