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

ABSPOSFA.m

Go to the documentation of this file. 
  1. ABSPOSFA ; IHS/FCS/DRS - Print NCPDP claim ;   [ 09/12/2002  10:08 AM ]
  1.  ;;1.0;PHARMACY POINT OF SALE;**3**;JUN 21, 2001;Build 38
  1.  ;----------------------------------------------------------------------
  1.  ;
  1.  ; This is the main routine for printing NCPDP forms.
  1.  ;
  1.  ; First, it calls ABSPOSFB (which calls ABSPOSFC, ABSPOSFD)
  1.  ;   to build an ABSP() array, just like is done for live claims.
  1.  ; Then, it calls ABSPOS__ to do the actual printing.
  1.  ;
  1.  Q
  1. SORT ;EP - from ABSPOSF - Sort prescriptions into
  1.  ; input: ^TMP("ABSPOSF",$J,1,ien57)="" or = insien
  1.  ; output:
  1.  ;   ^TMP("ABSPOSF",$J,2,inskey)=insien^name^address^^city^state^zip
  1.  ;   ^TMP("ABSPOSF",$J,2,inskey,patkey,pharm,visitien,ien57)=""
  1.  W !,"Sorting..."
  1.  N IEN57 S IEN57=0
  1.  F  S IEN57=$O(^TMP("ABSPOSF",$J,1,IEN57)) Q:'IEN57  D
  1.  . N INSNAME,INSIEN,PATIEN,PATNAME,PHARM,VISIT,INSKEY,PATKEY
  1.  . I '$D(^ABSPTL(IEN57)) Q  ; transaction record disappeared?!
  1.  . ;
  1.  . ; Insurance information:
  1.  . ;
  1.  . S INSIEN=^TMP("ABSPOSF",$J,1,IEN57)
  1.  . N PCNDFN S PCNDFN=$P(^ABSPTL(IEN57,0),U,3) ; posted to ILC A/R?
  1.  . I PCNDFN S INSIEN=$$ILCINS^ABSPOSF(PCNDFN) ; use ILC insurer instead
  1.  . I 'INSIEN S INSIEN=$P(^ABSPTL(IEN57,1),U,6)
  1.  . I 'INSIEN S INSIEN=0,INSNAME="ZZZZZ NO INSURANCE"
  1.  . E  S INSNAME=$P(^AUTNINS(INSIEN,0),U)
  1.  . S INSKEY=$E(INSNAME,1,20)_"#"_INSIEN
  1.  . I '$D(^TMP("ABSPOSF",$J,2,INSKEY)) D
  1.  . . N INSADDR,INSCITY,INSSTATE,INSZIP
  1.  . . I $$UNINS^ABSPOSF(INSNAME) D  Q  ; Bill these on statements? 
  1.  . . . S INSNAME="ZZZZZ NO INSURANCE"
  1.  . . . S (INSADDR,INSCITY,INSSTATE,INSZIP)=""
  1.  . . S INSADDR=$P(^AUTNINS(INSIEN,0),U,2)
  1.  . . S INSCITY=$P(^AUTNINS(INSIEN,0),U,3)
  1.  . . S INSSTATE=$P(^AUTNINS(INSIEN,0),U,4)
  1.  . . I INSSTATE S INSSTATE=$P(^DIC(5,INSSTATE,0),U,2)
  1.  . . S INSZIP=$P(^AUTNINS(INSIEN,0),U,5)
  1.  . . S ^TMP("ABSPOSF",$J,2,INSKEY)=INSIEN_U_INSNAME_U_INSADDR_U_U_INSCITY_U_INSSTATE_U_INSZIP
  1.  . S PATIEN=$P(^ABSPTL(IEN57,0),U,6)
  1.  . S PATNAME=$P(^DPT(PATIEN,0),U)
  1.  . S VISIT=+$P(^ABSPTL(IEN57,0),U,7)
  1.  . S PHARM=+$P(^ABSPTL(IEN57,1),U,7)
  1.  . S PATKEY=$E(PATNAME,1,20)_"#"_PATIEN
  1.  . S ^TMP("ABSPOSF",$J,2,INSKEY,PATKEY,PHARM,VISIT,IEN57)=""
  1.  W !
  1.  Q
  1. PRINT ; EP - from ABSPOSF 
  1.  W !,"Print on which device?",!
  1.  N POP D ^%ZIS Q:$G(POP)
  1.  U IO
  1.  ;
  1.  ; Build array TRANSACT(ien)=""
  1.  ; of pointers to 9002313.57
  1.  ; for the transactions for which to print forms.
  1.  ;
  1.  ; then for each pair, D PRINT^ABSPOSFP
  1.  N INSNAME,PATNAME,PHARM,VISITIEN,IEN57
  1.  S INSNAME=""
  1.  F  S INSNAME=$O(^TMP("ABSPOSF",$J,2,INSNAME)) Q:INSNAME=""  D
  1.  . Q:INSFIRST]INSNAME  ; EPILC needs this test here
  1.  . I '$$TOSCREEN^ABSPOSU5 D
  1.  . . U $P
  1.  . . W "Printing for ",INSNAME,!
  1.  . . U IO
  1.  . S PATNAME=""
  1.  . F  S PATNAME=$O(^TMP("ABSPOSF",$J,2,INSNAME,PATNAME)) Q:PATNAME=""  D
  1.  . . S PHARM=""
  1.  . . F  S PHARM=$O(^TMP("ABSPOSF",$J,2,INSNAME,PATNAME,PHARM)) Q:PHARM=""  D
  1.  . . .  D VISITS
  1.  D ^%ZISC
  1.  Q
  1. VISITS ; at ^TMP("ABSPOSF",$J,2,INSNAME,PATNAME,PHARM)
  1.  S VISITIEN=""
  1.  F  S VISITIEN=$O(^TMP("ABSPOSF",$J,2,INSNAME,PATNAME,PHARM,VISITIEN)) Q:VISITIEN=""  D
  1.  . N TRANSACT
  1.  . M TRANSACT=^TMP("ABSPOSF",$J,2,INSNAME,PATNAME,PHARM,VISITIEN)
  1.  . D PRINTV(^TMP("ABSPOSF",$J,2,INSNAME))
  1.  Q
  1. PRINTV(INSINFO) ; we have TRANSACT(ien57)="" for a bunch of prescriptions
  1.  ; INSINFO=INSIEN^NAME^ADDR 1^ADDR 2^CITY^STATE^ZIP
  1.  N ABSP,NCPDP
  1.  Q:$$ABSP^ABSPOSFB'=0  ; builds ABSP() array for these transactions
  1.  ; augment ABSP() with insurance name and address
  1.  S ABSP("Insurer","Name")=$P(INSINFO,U,2)
  1.  S ABSP("Insurer","Addr 1")=$P(INSINFO,U,3)
  1.  S ABSP("Insurer","Addr 2")=$P(INSINFO,U,4)
  1.  S ABSP("Insurer","City")=$P(INSINFO,U,5)
  1.  S ABSP("Insurer","State")=$P(INSINFO,U,6)
  1.  S ABSP("Insurer","Zip")=$P(INSINFO,U,7)
  1.  D NCPDP ; builds NCPDP() array ; with overrides as appropriate
  1.  ;      NCPDP(field #)=value ; NCPDP("RX",rxn,field#)=value
  1.  D PRINT^ABSPOSFP ; output the ABSP(*) and NCPDP(*) arrays onto form(s)
  1.  Q
  1. NCPDP ; Build NCPDP(field #)=value
  1.  ;       NCPDP("RX",rxn,field #)=value
  1.  ; Loop through every NCPDP field and Xecute the "Get" code.
  1.  ; (checking for overrides, in which case the "Get" doesn't happen)
  1.  ; Then store the result in the NCPDP array, as above.
  1.  ; Note that we will have EVERY field defined, even if value is null.
  1.  N RXN,FIELDNUM,FIELDIEN S FIELDNUM=0
  1.  F  S FIELDNUM=$O(^ABSPF(9002313.91,"B",FIELDNUM)) Q:'FIELDNUM  D
  1.  . I FIELDNUM<200 Q  ; BIN, Version, Transaction Code are n/a
  1.  . S FIELDIEN=$O(^ABSPF(9002313.91,"B",FIELDNUM,0))
  1.  . I FIELDNUM<400 D  ; Claim Header field - just once for all
  1.  . . I $D(ABSP("OVERRIDE",FIELDNUM)) D
  1.  . . . S ABSP("X")=ABSP("OVERRIDE",FIELDNUM)
  1.  . . E  D
  1.  . . . D NCPDP1
  1.  . . S NCPDP(FIELDNUM)=ABSP("X")
  1.  . . K ABSP("X")
  1.  . E  D  ; Claim Information field - once per prescription
  1.  . . N RXN S RXN=0
  1.  . . F  S RXN=$O(ABSP("RX",RXN)) Q:'RXN  D
  1.  . . . I $D(ABSP("OVERRIDE","RX",RXN,FIELDNUM)) D
  1.  . . . . S ABSP("X")=ABSP("OVERRIDE","RX",RXN,FIELDNUM)
  1.  . . . E  D
  1.  . . . . S ABSP(9002313.0201)=RXN
  1.  . . . . D NCPDP1
  1.  . . . S NCPDP("RX",RXN,FIELDNUM)=ABSP("X")
  1.  . . K ABSP(9002313.0201),ABSP("X")
  1.  Q
  1. NCPDP1 ;
  1.  N D1 S D1=0,ABSP("X")=""
  1.  F  S D1=$O(^ABSPF(9002313.91,FIELDIEN,10,D1)) Q:'D1  D
  1.  . X ^ABSPF(9002313.91,FIELDIEN,10,D1,0)
  1.  Q  ; with ABSP("X") set up
  1. TEST ; a test - find a bunch of recent transactions 
  1.  ; and set up ^TMP("ABSPOSF",$J,1,IEN57)
  1.  K ^TMP("ABSPOSF",$J)
  1.  N IEN57 S IEN57=$P(^ABSPTL(0),U,3)+1 ; setup for $O in reverse
  1.  N NTRANS S NTRANS=2 ; take two transactions
  1.  F  D  Q:'NTRANS  Q:'IEN57
  1.  . S IEN57=$O(^ABSPTL(IEN57),-1) Q:'IEN57
  1.  . ; don't take ones that went electronic transactions
  1.  . ; (though there's no real reason we couldn't)
  1.  . I $$GET1^DIQ(9002313.57,IEN57_",","RESULT WITH REVERSAL")?1"E ".E Q
  1.  . N INS S INS=$P(^ABSPTL(IEN57,1),U,6)
  1.  . Q:'INS  Q:$$UNINS^ABSPOSF($P(^AUTNINS(INS,0),U))  ;
  1.  . S ^TMP("ABSPOSF",$J,1,IEN57)="",NTRANS=NTRANS-1 ; YES  add to list
  1.  W "Sorting..." D SORT W !
  1.  D
  1.  . W "results of SORT:",!
  1.  . N TMP M TMP=^TMP("ABSPOSF",$J) D ZWRITE^ABSPOS("TMP")
  1.  W "Printing..." W ! D PRINT W ! ; print to current device; capture
  1.  Q