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

BPSOSO2.m

Go to the documentation of this file. 
  1. BPSOSO2 ;BHAM ISC/FCS/DRS/DLF - NCPDP Override-Fman utils ;06/01/2004
  1.  ;;1.0;E CLAIMS MGMT ENGINE;**1,3,5,10,11**;JUN 2004;Build 27
  1.  ;;Per VHA Directive 2004-038, this routine should not be modified.
  1.  Q
  1.  ; EDIT,EDITGEN are called from the menus in BPSOSO1,
  1.  ;   typically reached from the pharmacy package's call
  1.  ;   to OVERRIDE^BPSOSO
  1.  ; GET511 called from BPSOSCD during claim construction
  1.  ;
  1.  ;IHS/SD/lwj 8/01/02  NCPDP 5.1 changes to GET511 subroutine
  1.  ; Routine was changed to look at an exceptions list, if the
  1.  ; field being processed is in the exceptions list it will
  1.  ; create a "claim header" and "claim rx" entry.  The reason
  1.  ; for this is that several 300 range fields were moved to the
  1.  ; claim rx area within the 5.1 segments creating duplicate flds.
  1.  ; (i.e. the <402 and >402 rule is no longer valid)
  1.  ;
  1.  ; subroutine PRIORA added to handle the input of the prior
  1.  ; authorization information at prescription creation time.
  1.  ;
  1. EDIT(IEN,FIELDNUM) ;
  1.  I '$D(FIELDNUM) D EDITGEN(IEN) Q
  1.  ; Editing one field
  1.  N DIE,DA,DR,DIDEL,DTOUT,FIELDNAM
  1.  S DA=$$HASVALUE(IEN,FIELDNUM)
  1.  ; Make sure the entry exists in the subfile.
  1.  ; Create an empty one if necessary.
  1.  I 'DA S DA=$$SETVALUE(IEN,FIELDNUM,"")
  1.  ; edit the value field in the subfile
  1.  S DIE="^BPS(9002313.511,"_IEN_",1,",DA(1)=IEN
  1.  S DR=.02_$TR($$FIELDNAM(FIELDNUM),""";~","")
  1.  D ^DIE
  1.  ; If the value is null, then delete the entire FIELDNUM entry
  1.  I $$GETVALUE(IEN,FIELDNUM)="" D DELVALUE(IEN,FIELDNUM)
  1.  Q
  1.  ;
  1. EDITGEN(IEN) ; general edit
  1.  ; First pass:  quick & dirty Fileman ^DIE call
  1.  ; Future: Screenman interface
  1.  N DIE,DA,DR,DIDEL,DTOUT
  1.  S DA=IEN,DIE=$$FILENUM,DR=1 D ^DIE
  1.  ; And we need to delete any entries with null values
  1.  N A S A=0 F  S A=$O(^BPS(9002313.511,IEN,1,A)) Q:'A  D
  1.  . N X S X=^BPS(9002313.511,IEN,1,A,0)
  1.  . I $P(X,U,2)="" D
  1.  . . N FIELDNUM S FIELDNUM=$P(^BPSF(9002313.91,$P(X,U),0),U)
  1.  . . D DELVALUE(IEN,FIELDNUM)
  1.  Q
  1. GET511(IEN,ARR101,ARR402) ;function, called from BPSOSCD - load arrays with data from IEN
  1.  ;
  1.  N A,BPFLDNUM,C,F,HDRLST,MULTLST,TFLD,X
  1.  ;
  1.  ; Build exception lists
  1.  S HDRLST=",524,",MULTLST=",147,308,315,316,317,318,319,320,327,357,"
  1.  ;
  1.  S A=0,C=0
  1.  F  S A=$O(^BPS(9002313.511,IEN,1,A)) Q:'A  D
  1.  . S X=^BPS(9002313.511,IEN,1,A,0)
  1.  . S F=$P(X,U) ; Field IEN, points to 9002313.91
  1.  . ; Store in either claim header or claim detail, based on field #
  1.  . ; Note that logic below will put 401 field in both header and detail
  1.  . S BPFLDNUM=+$$FIELDNUM(F)
  1.  . S TFLD=","_BPFLDNUM_","
  1.  . I BPFLDNUM<402!(HDRLST[TFLD) S @ARR101@(F)=$P(X,U,2)
  1.  . I BPFLDNUM>401!(MULTLST[TFLD) S @ARR402@(F)=$P(X,U,2)
  1.  . ;
  1.  . S C=C+1
  1.  ;
  1.  Q C  ; return count
  1.  ;
  1.  ;  utilities
  1. LOCK() L +^BPS(9002313.511,IEN):300 Q $T
  1.  ;
  1. UNLOCK L -^BPS(9002313.511,IEN) Q
  1.  ;
  1. FILENUM() Q 9002313.511  ; BPS NCPDP OVERRIDE (#9002313.511)
  1.  ;
  1. SUBFNUM() Q 9002313.5111  ; NCPDP FIELD SUB-FIELD^^.02^2
  1.  ;
  1. FLOCK() L +^BPS(9002313.511):300 Q $T
  1.  ;
  1. FUNLOCK L -^BPS(9002313.511) Q
  1.  ;
  1. FIELDIEN(FIELDNUM) ; function, ien of BPS NCPDP FIELD DEFS (#9002313.91) Data Dictionary field
  1.  Q $$FIND1^DIC(9002313.91,,,FIELDNUM)
  1.  ;
  1. FIELDNAM(FIELDNUM) ; function, name of a 9002313.91 NCPDP Data Dictionary field
  1.  Q $$GET1^DIQ(9002313.91,$$FIELDIEN(FIELDNUM),.03)
  1.  ;
  1.  ; for IEN in BPS NCPDP FIELD DEFS (#9002313.91) return external #
  1. FIELDNUM(IEN91) Q $P($G(^BPSF(9002313.91,IEN91,0)),U)
  1.  ;
  1. NEW() ;EP -  function, create new entry in 9002313.511
  1.  F  Q:$$FLOCK  Q:'$$IMPOSS^BPSOSUE("L","RTI","interlock on new Override record creation",,"NEW",$T(+0))
  1.  N FLAGS,FDA,IEN,MSG,FN,X,NEWREC S FN=$$FILENUM
  1.  D NEW1
  1.  D FUNLOCK
  1.  Q NEWREC
  1.  ;
  1. NEW1 ;
  1.  S FDA(FN,"+1,",.01)=$O(^BPS(FN,"B",999999999999),-1)+1
  1.  D UPDATE^DIE(,"FDA","IEN","MSG")
  1.  I $D(MSG) D  G NEW1:$$IMPOSS^BPSOSUE("FM","TRI","UPDATE^DIE failed",,"NEW1",$T(+0))
  1.  . D ZWRITE^BPSOS("FDA","IEN","MSG")
  1.  . K MSG
  1.  S NEWREC=IEN(1)
  1. NEW2 ;
  1.  S FDA(FN,NEWREC_",",.02)="NOW"
  1.  D FILE^DIE("E","FDA","MSG")
  1.  Q:'$D(MSG)  ; success
  1.  G NEW2:$$IMPOSS^BPSOSUE("FM","TRI","FILE^DIE failed",,"NEW2",$T(+0))
  1.  Q
  1.  ;
  1. HASVALUE(IEN,FIELDNUM) ; function, does the FIELDNUM have an override value?
  1.  ; returns IEN into the subfile
  1.  Q $$FIND1^DIC($$SUBFNUM,","_IEN_",",,FIELDNUM)
  1.  ;
  1. GETVALUE(IEN,FIELDNUM) ; function, return currently-set override value for given FIELDNUM
  1.  N X S X=$$HASVALUE(IEN,FIELDNUM) I 'X Q ""
  1.  Q $$GET1^DIQ($$SUBFNUM,X_","_IEN_",",.02)
  1.  ;
  1. SETVALUE(IEN,FIELDNUM,VALUE) ; function, returns ien in subfile for this FIELDNUM
  1.  ; Special case for the override file:  if you're trying to set the
  1.  ; field's value to "@", don't just delete the field value,
  1.  ; which would leave the field defined with a null value.
  1.  ; Instead, delete the entire override for the field.
  1.  ; This prevents accidentally overriding a genuine value with null.
  1.  I "@"=VALUE D DELVALUE(IEN,FIELDNUM) Q ""
  1.  ;
  1.  ; But the usual case is just storing a value:
  1.  N FDA,MSG,IENS,IENARRAY
  1.  ; check  if there's already an entry for the fieldnum, if not put in a "+1,"
  1.  N ENTRY S ENTRY=$$HASVALUE(IEN,FIELDNUM) ; do we already have FIELDNUM?
  1.  I 'ENTRY S ENTRY="+1" ; create a new entry
  1.  ;
  1.  S IENS=ENTRY_","_IEN_","
  1.  S FDA($$SUBFNUM,IENS,.01)=FIELDNUM
  1.  S FDA($$SUBFNUM,IENS,.02)=VALUE
  1.  D SETV1
  1.  I ENTRY="+1" S ENTRY=$G(IENARRAY(1))
  1.  Q ENTRY
  1.  ;
  1. SETV1 ;
  1.  D UPDATE^DIE("E","FDA","IENARRAY","MSG")
  1.  Q:'$D(MSG)  ; success
  1.  K ^TMP("BPS",$J,"BPSOSO2",$J,"SETVALUE")
  1.  S ^TMP("BPS",$J,"BPSOSO2",$J,"SETVALUE")=$$ERRHDR
  1.  M ^TMP("BPS",$J,"BPSOSO2",$J,"SETVALUE","MSG")=MSG
  1.  I $D(IENARRAY) M ^TMP("BPS",$J,"BPSOSO2",$J,"SETVALUE","IENARRAY")=IENARRAY
  1.  D ZWRITE^BPSOS("FDA","IENARRAY","MSG")
  1.  G SETV1:$$IMPOSS^BPSOSUE("FM","TRI",,,"SETVALUE",$T(+0))
  1.  Q
  1.  ;
  1. DELVALUE(IEN,FIELDNUM) ;
  1.  N ENTRY S ENTRY=$$HASVALUE(IEN,FIELDNUM) Q:'ENTRY  ; wasn't defined
  1.  N FDA,MSG
  1.  S FDA($$SUBFNUM,ENTRY_","_IEN_",",.01)="@"
  1. DE5 D FILE^DIE("E","FDA","MSG")
  1.  Q:'$D(MSG)  ; success
  1.  K ^TMP("BPS",$J,"BPSOSO2",$J,"DELVALUE")
  1.  S ^TMP("BPS",$J,"BPSOSO2",$J,"DELVALUE")=$$ERRHDR
  1.  D ZWRITE^BPSOS("IEN","FDA","MSG")
  1.  G DE5:$$IMPOSS^BPSOSUE("FM","TRI",,,"DELVALUE",$T(+0))
  1.  Q
  1.  ;
  1. ERRHDR() Q "ERROR AT $H="_$H_" FOR $J="_$J
  1.  ;
  1. SEE(IEN) N TMP M TMP=^BPS($$FILENUM,IEN) D ZWRITE^BPSOS("TMP") Q  ; debugging
  1.  ;
  1. PRIORA(IEN) ;IHS/SD/lwj 9/3/02 Prior Authorization
  1.  ; used to populate fields 461, 462 and 416.  416 will be created based on the input into fields 461, and 462.
  1.  ;
  1.  N FIELDNUM
  1.  ;
  1.  S FIELDNUM=461  ; 461-EU Prior Authorization Type Code
  1.  D EDIT(IEN,FIELDNUM)
  1.  S FIELDNUM=462  ; 462-EV Prior Authorization Number Submitted
  1.  D EDIT(IEN,FIELDNUM)
  1.  ;
  1.  ; combine field 461 and 462 to create 416-DG Prior Authorization/Medical Certification Code And Number
  1.  ;
  1.  N VAL461,VAL462,VAL416,DA
  1.  S VAL461=$$GETVALUE(IEN,461)
  1.  S VAL462=$$GETVALUE(IEN,462)
  1.  S VAL416=VAL461_VAL462
  1.  Q:VAL416=""
  1.  ;
  1.  S DA=$$SETVALUE(IEN,416,"")
  1.  S:$G(DA)'="" DA=$$SETVALUE(IEN,416,VAL416)
  1.  ;
  1.  Q
  1.  ;