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

ABSPOSO1.m

Go to the documentation of this file.
  1. ABSPOSO1 ; IHS/FCS/DRS - NCPDP Override Main menu ; [ 09/03/2002 11:14 AM ]
  1. ;;1.0;PHARMACY POINT OF SALE;**3,6,7**;JUN 21, 2001;Build 38
  1. ;---------------------------------------------------------------
  1. ; IHS/SD/lwj 9/3/02 NCPDP 5.1 changes
  1. ; In 3.2, prior authorization was updated and stored in field 416.
  1. ; In 5.1, 416 is obsolete, and the information could be stored
  1. ; in field 461, and 462 or in the prior authorization segment.
  1. ; For now, the insurer/processors appear to be using 461, and
  1. ; 462 rather than the segment. In any case, we needed to change
  1. ; the way we capture prior authorization information - AND - we
  1. ; have to keep populating 416 since we have to still process 3.2
  1. ; claims. This routine was changed to call PRIORA in ABSPOSo2
  1. ; rather than EDIT^ABSPOSO2 when we are processing a prior auth.
  1. ;(Field prompts also altered to match 5.1 standards.)
  1. ;---------------------------------------------------------------
  1. ;IHS/SD/lwj 6/10/03 Multiple changes
  1. ; First, new logic was added to prompt for and store the
  1. ; values for the 5.1 DUR multiple. Second, code in MENU
  1. ; altered to avoid <NOLINE> error when the prompt time
  1. ; outs and a value is not entered.
  1. ;---------------------------------------------------------------
  1. ;IHS/SD/lwj 9/4/03 patch 7 V1.0 prior authorization menu
  1. ; option altered to reflect 3.2 only
  1. ;---------------------------------------------------------------
  1. Q
  1. TEST D MENU("") Q
  1. ;
  1. ;IHS/SD/lwj 6/19/03 patch 6 POS separate ien and dien if dien there
  1. ;
  1. S DIEN=$P(IEN,U,2)
  1. S IEN=$P(IEN,U)
  1. ;end changes IHS/SD/lwj 6/19/03 patch 6
  1. ;
  1. D SETLIST
  1. N PROMPT S PROMPT(1)="Select which claim data you wish to override."
  1. S PROMPT(2)="Use ^ to exit this menu."
  1. N SEL F D Q:'SEL Q:SEL=-1
  1. . S SEL=$$LIST^ABSPOSU4("S",$$LISTROOT,$$ANSROOT,"Override Claim Defaults",.PROMPT,1,20,$S($G(DTOUT):DTOUT,1:300))
  1. .;IHS/SD/lwj 6/10/03 time out causes error next line
  1. .;remarked out, following line added to avoid <NOLINE>
  1. . ;I SEL W ! H 1 D @$P($T(LIST+SEL),";",4) ;
  1. . I +SEL>0 W ! H 1 D @$P($T(LIST+SEL),";",4) ;
  1. Q
  1. LISTROOT() Q "^TMP("""_$T(+0)_""","_$J_","
  1. ANSROOT() Q "^TMP("""_$T(+0)_""","_($J+.1)_","
  1. SETLIST K ^TMP("ABSPOSO1",$J),^TMP("ABSPOSO1",$J+.1)
  1. N I,X F I=1:1 D Q:X="*"
  1. . S X=$T(LIST+I),X=$P(X,";",2,$L(X)) Q:X="*"
  1. . S ^TMP("ABSPOSO1",$J,I,"I")=$P(X,";")
  1. . S ^TMP("ABSPOSO1",$J,I,"E")=$P(X,";",2)
  1. S ^TMP("ABSPOSO1",$J,0)=I-1
  1. Q
  1. ;
  1. ; IHS/SD/lwj 9/3/02 - the following 3 lines were removed from LIST -
  1. ; new 1 - 3 lines were added to replace them
  1. ;1;Preauthorization #;EDIT^ABSPOSO2(IEN,416)
  1. ;2;Person Code;EDIT^ABSPOSO2(IEN,303)
  1. ;3;Relationship Code;EDIT^ABSPOSO2(IEN,306)
  1. ;
  1. ; IHS/SD/lwj 9/3/02 - since still unimplemented, the following
  1. ; lines were removed from the menu options in LIST
  1. ;I;Order of insurance;NOTIMP
  1. ;P;Pricing;NOTIMP
  1. ;
  1. LIST ;
  1. ;1;Prior Authorization (3.2);PRIORA^ABSPOSO2(IEN) ;IHS/SD/lwj 9/3/02
  1. ;2;Patient Gender Code;EDIT^ABSPOSO2(IEN,303)
  1. ;3;Patient Relationship Code;EDIT^ABSPOSO2(IEN,306)
  1. ;4;Eligibility Clarification Code;EDIT^ABSPOSO2(IEN,309)
  1. ;5;NCPDP 5.1 DUR Segment Input;EDIT^ABSPOSD2(DIEN)
  1. ;*;Enter/edit/override any NCPDP field;EDIT^ABSPOSO2(IEN)
  1. ;*
  1. NOTIMP W !,"That option isn't yet implemented.",! N % R %:3 Q