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

ABSPOSF.m

Go to the documentation of this file. 
  1. ABSPOSF ; 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.  ; Directory of ABSPOSF* routines:
  1.  ;
  1.  ; ABSPOSF - main entry points
  1.  ; ABSPOSFA - SORT and PRINT
  1.  ; ABSPOSFB-ABSPOSFD - assemble ABSP() and NCPDP() arrays
  1.  ; ABSPOSFP - the actual printing takes place here
  1.  ; ABSPOSFX - details of the alignment (test print)
  1.  ;
  1.  Q
  1. PRINT ; EP - ; For printing forms at a site which doesn't have ILC A/R:
  1.  ; Option name ABSP NCPDP FORMS PRINT
  1.  ;    prompt for a date range
  1.  ;    and "start at insurer"
  1.  ;    and "are you sure?"
  1.  N PROMPT1,PROMPT2,DEF1,DEF2
  1.  S PROMPT1="Starting with what transaction date? "
  1.  S PROMPT2="  Ending with what transaction date? "
  1.  S DEF1="",DEF2=""
  1.  W !!,"Print NCPDP Pharmacy Claim Forms",!!
  1.  N RANGE S RANGE=$$DTR^ABSPOSU1(PROMPT1,PROMPT2,DEF1,DEF2,1) W !
  1.  I 'RANGE Q
  1.  N X S X=$P(RANGE,U,2) ; go through end of last day, if no time given
  1.  I $P(X,".",2)="" S $P(X,".",2)=24,$P(RANGE,U,2)=X
  1.  ;
  1.  ; Start printing at what insurer?
  1.  ;
  1.  N INSFIRST S INSFIRST=$$INSFIRST Q:"^^"[INSFIRST
  1.  ;
  1.  ; Build ^TMP("ABSPOSF",$J,1,ien57)=""
  1.  W !,"Now building a list of transactions for which to print forms...",!
  1.  K ^TMP("ABSPOSF",$J)
  1.  ; Scan ^ABSPTL("AH",last update date-time,ien57)
  1.  N COUNT S COUNT=0
  1.  N WHEN S WHEN=$P(RANGE,U) ; start at the start time
  1.  F  D  Q:'WHEN  Q:WHEN>$P(RANGE,U,2)  ; scan thru the end time
  1.  . N IEN57 S IEN57=0
  1.  . F  S IEN57=$O(^ABSPTL("AH",WHEN,IEN57)) Q:'IEN57  D
  1.  . . ; Include only transactions whose RESULT WITH REVERSAL = "PAPER"
  1.  . . Q:$$GET1^DIQ(9002313.57,IEN57_",","RESULT WITH REVERSAL")'="PAPER"
  1.  . . ; Exclude:
  1.  . . ;  1. No insurance
  1.  . . N INS S INS=$P(^ABSPTL(IEN57,1),U,6) Q:'INS
  1.  . . N INSNAME S INSNAME=$P($G(^AUTNINS(INS,0)),U) Q:INSNAME=""
  1.  . . ;  3. Insurance name comes before starting point
  1.  . . I INSFIRST]INSNAME Q
  1.  . . I $$UNINS^ABSPOSF(INSNAME) Q  ;names like SELF PAY or UNINSURED
  1.  . . ;  2. Any with a subsequent transaction for the same ENTRY #
  1.  . . N RXIRXR S RXIRXR=$P(^ABSPTL(IEN57,0),U)
  1.  . . I $O(^ABSPTL("B",RXIRXR,IEN57)) Q
  1.  . . ; Succeeded: this transaction deserves a claim form
  1.  . . S ^TMP("ABSPOSF",$J,1,IEN57)=""
  1.  . . S COUNT=COUNT+1
  1.  . S WHEN=$O(^ABSPTL("AH",WHEN)) ; bump up to next transaction time
  1. JOIN ; REPRINT joins here
  1.  W !,"Number of claims: ",COUNT,!
  1.  I 'COUNT Q
  1.  I COUNT>1 D
  1.  . W "Note: because some forms may have two claims on the same page,",!
  1.  . W "you might print fewer than ",COUNT," forms.",!
  1.  N X S X=$$YESNO^ABSPOSU3("Okay to proceed","",0)
  1.  I X'=1 D  Q
  1.  . W !,"Nothing done.",!
  1.  D SORT^ABSPOSFA
  1.  D PRINT^ABSPOSFA
  1.  ; 
  1.  Q
  1. ALIGN ;EP - align NCPDP forms
  1.  ; Option name ABSP NCPDP FORMS ALIGN
  1.  W !,"Test print for NCPDP forms",!
  1.  N POP D ^%ZIS Q:$G(POP)
  1. ALIGN1 U IO
  1.  D ALIGN^ABSPOSFX
  1.  U $P
  1.  I $$YESNO^ABSPOSU3("Print again","NO",1) G ALIGN1
  1.  D ^%ZISC
  1.  Q
  1. REPRINT ;EP - reprint selected NCPDP forms
  1.  ; Option name ABSP NCPDP FORMS REPRINT
  1.  W !!,"Reprint selected NCPDP forms",!!
  1.  W "First, select the patient(s).",!
  1.  N PATARRAY,PAT57,IEN57
  1.  F  S PAT57=$$PAT57 Q:'PAT57  S PATARRAY(PAT57)=""
  1.  I '$O(PATARRAY("")) Q  ; none selected
  1.  W !!,"Choose a transaction date or range of transaction dates",!
  1.  W "for which to reprint NCPDP forms for the selected patient(s).",!
  1.  N RANGE S RANGE=$$DTR^ABSPOSU1(PROMPT1,PROMPT2,DEF1,DEF2,1) W !
  1.  I 'RANGE Q
  1.  N X S X=$P(RANGE,U,2) ; go through end of last day, if no time given
  1.  I $P(X,".",2)="" S $P(X,".",2)=24,$P(RANGE,U,2)=X
  1.  W !,"Gathering the selected transactions..." S COUNT=0
  1.  N WHEN S WHEN=$P(RANGE,U)
  1.  F  D  Q:'WHEN  Q:WHEN>$P(RANGE,U,2)
  1.  . S IEN57=0
  1.  . F  S IEN57=$O(^ABSPTL("AH",WHEN,IEN57)) Q:'IEN57  D
  1.  . . S PAT57=$P(^ABSPTL(IEN57,0),U,6)
  1.  . . Q:'PAT57  Q:'$D(PATARRAY(PAT57))
  1.  . . S ^TMP("ABSPOSF",$J,1,IEN57)="",COUNT=COUNT+1
  1.  . S WHEN=$O(^ABSPTL("AH",WHEN))
  1.  N INSFIRST S INSFIRST=" "
  1.  G JOIN ; up above - to SORT and PRINT
  1. PAT57() ; Lookup patient in 9002313.57 transactions
  1.  N DIC,X,DLAYGO,Y
  1.  S DIC=2,DIC(0)="AMQ"
  1.  S DIC("A")="Reprint for which patient?"
  1.  S DIC("S")="I $D(^ABSPTL(""AC"",Y)"
  1.  D ^DIC W !
  1.  I Y<0 Q $S($D(DTOUT):"^",$D(DUOUT):"^",1:"")
  1.  S Y=+Y
  1.  N IEN57 S IEN57=$O(^ABSPTL("AC",Y,0))
  1.  N DATE1 S DATE1=$P(^ABSPTL(IEN57,0),U,8)\1
  1.  S IEN57=$O(^ABSPTL("AC",Y,""),-1)
  1.  N DATE2 S DATE2=$P(^ABSPTL(IEN57,0),U,8)\1
  1.  W ?10,"Transaction date" I DATE1'=DATE2 W "s" W " "
  1.  S Y=DATE1 X ^DD("DD") W Y
  1.  I DATE1'=DATE2 S Y=DATE2 X ^DD("DD") W " - ",Y
  1.  W !
  1.  Q
  1. ILCPRINT ; EP - ; For printing forms from ILC A/R pre-bill list
  1.  ; Build ^TMP("ABSPOSF",$J,1,ien57)
  1.  W !,"Print NCPDP forms",!
  1.  N INSFIRST S INSFIRST=$$INSFIRST Q:"^^"[INSFIRST
  1.  I INSFIRST]" " D
  1.  . W !,"Note:  if you answer YES to an ""Okay to update bills?"" question,",!
  1.  . W "later on in the ILC A/R system, it will update all the bills,",!
  1.  . W "not only the ones which were printed starting at ",INSFIRST,".",!
  1.  W !,"Gathering claims from the NCPDP Prebill List in the A/R system..."
  1.  K ^TMP("ABSPOSF",$J)
  1.  N PCNDFN S PCNDFN=0
  1.  ; Loop through the ILC A/R Prebilling list for NCPDP forms:
  1.  F  S PCNDFN=$O(^ABSBITMS(9002302,"APRX1",1,PCNDFN)) Q:'PCNDFN  D
  1.  . I INSFIRST]" ",INSFIRST]$$ILCINSNM(PCNDFN) Q  ; starting at later pt
  1.  . N IEN57 S IEN57=0
  1.  . F  S IEN57=$O(^ABSPTL("C",PCNDFN,IEN57)) Q:'IEN57  D
  1.  . . S ^TMP("ABSPOSF",$J,1,IEN57)=""
  1.  W !
  1.  D SORT^ABSPOSFA
  1.  I '$$YESNO^ABSPOSU3("Okay to continue","",0) W !
  1.  D PRINT^ABSPOSFA
  1.  Q
  1. INSFIRST() ; returns where to start printing or "" or "^" or "^^" to cancel
  1.  N RET
  1.  S RET=$$YESNO^ABSPOSU3("Print for all insurers","YES",0)
  1.  I RET=1 Q " " ; start at beginning, then
  1.  I RET'=0 Q RET ; back out
  1.  ; No, don't start at beginning
  1.  S RET=$$FREETEXT^ABSPOSU2("Print forms alphabetically starting where"," ",1,1,30) W !
  1.  Q RET
  1. ILCINS(PCNDFN) ; EP - get the ILC insurer IEN
  1.  N X S X=$P($G(^ABSBITMS(9002302,PCNDFN,0)),U,4) ; int. audit ins.
  1.  I 'X S X=1
  1.  I '$D(^ABSBITMS(9002302,PCNDFN,"INSCOV1",X,1)) Q
  1.  S X=$P(^ABSBITMS(9002302,PCNDFN,"INSCOV1",X,1),U,2)
  1.  I X S INSIEN=X
  1.  Q
  1. ILCINSNM(PCNDFN) ; EP - get the ILC insurer name
  1.  Q $P(^ABSBITMS(9002302,PCNDFN,0),U,3) ; easy - AUDIT INSURER field
  1. UNINS(NAME) ; EP - is it an uninsured kind of pseudo-insurance
  1.  I NAME?1"SELF".E Q 1
  1.  I NAME?1"UNINS".E Q 1
  1.  Q 0