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

ABSPOSIH.m

Go to the documentation of this file. 
  1. ABSPOSIH ; IHS/FCS/DRS - NCPDP 5.1 DUR Overrides form ;   [ 06/03/2002  4:40 AM ]
  1.  ;;1.0;PHARMACY POINT OF SALE;**6,48**;JUN 21, 2001;Build 38
  1.  ; Property of Indian Health Service
  1.  ;
  1.  Q
  1. PREINIT ;EP - check for existing record
  1.  ; This is the pre-init routine tied to the
  1.  ; ABSP INPUT 5.1 DUR INPUT block on the ABSP Input Data screen
  1.  ; This is used during the creation of the "new" claim from
  1.  ; within POS  (called from the "USER" screen) to capture
  1.  ; NCPDP 5.1 DUR override values.
  1.  ;
  1.  ;
  1.  N RXI,RXR,OVERDUR,FDA,STRING
  1.  ;
  1.  ; get the prescription information
  1.  S RXI=$$GET^DDSVAL(DIE,.DA,1.01)    ;RX IEN
  1.  S RXR=$$GET^DDSVAL(DIE,.DA,1.02)    ;RX Refill IEN
  1.  S OVERDUR=""
  1.  ;
  1.  Q:$G(RXI)=""  ;no pres - get out  
  1.  ;
  1.  S OVERDUR=$$GETDUR^ABSPOSO(RXI,RXR)   ;get dur override number
  1.  ;
  1.  I $G(OVERDUR)'="" D         ;override exists
  1.  . S STRING(1)="Will add override from IEN RX  "_RXI  ;msg on scrn
  1.  . S:+RXR STRING(1)=STRING(1)_"   IEN Refill  "_RXR
  1.  . D HLP^DDSUTL(.STRING)      ;displays what is happening
  1.  . ;
  1.  I $G(OVERDUR)="" D        ;override doesn't exist yet
  1.  . S OVERDUR=$$NEW^ABSPOSD2
  1.  . S STRING(1)="Will add new Override  "_OVERDUR
  1.  . D HLP^DDSUTL(.STRING)
  1.  ;
  1.  ; create empty entries for adding new data
  1.  D NEWSUB^ABSPOSD2(OVERDUR)
  1.  ;
  1.  ; now- update the input data file and the prescription
  1.  D UPDRX(RXI,RXR,OVERDUR)
  1.  D PUT^DDSVAL(DIE,.DA,1.13,OVERDUR,,"I")
  1.  ;
  1.  ; theres a chance they won't file the claim - hold on to the
  1.  ; dur so we can clean up empty records if its not filed
  1.  ;
  1.  S ^TMP("ABSPOSIH",$J,OVERDUR)=RXI_"^"_RXR
  1.  ;
  1.  Q
  1.  ;
  1. CLNDUR(IEN,ENTRY) ;EP - clean up the DUR file of empty entries
  1.  ; and update the RX file when no override information
  1.  ; was actually entered for the 5.1 DUR segment.
  1.  ; This routine called from ABSPOSIZ - subroutine FILE
  1.  ;
  1.  ;
  1.  N OVERDUR,DATAREC
  1.  ;
  1.  S DATAREC=$G(^ABSP(9002313.51,IEN,2,ENTRY,1))
  1.  ;
  1.  S OVERDUR=$P(DATAREC,"^",10)
  1.  Q:OVERDUR=""   ;IHS/SD/lwj 8/4/03 just quit
  1.  ;
  1.  S RXI=$P(DATAREC,"^")
  1.  S RXR=$P(DATAREC,"^",2)
  1.  ;
  1.  S OVERDUR=$$CHKDUR^ABSPOSD2(OVERDUR)  ;good data input?
  1.  ;
  1.  I $G(OVERDUR)="" D   ;nothing input - delete it
  1.  . D UPDRX(RXI,RXR,OVERDUR)
  1.  . N FDA,ZERR  ; /IHS/OIT/RAM ; 12 JUN 17 ; ADD DBS CALL ERROR RETURN VARIABLE
  1.  . S FDA(9002313.51,ENTRY_","_IEN_",",1.13)=OVERDUR
  1.  . D FILE^DIE("","FDA","ZERR") ; /IHS/OIT/RAM ; 12 JUN 17 ; UPDATE DBS CALL TO ALLOW FOR ERROR RETURN.
  1.  . I $D(ZERR) D LOG^ABSPOSL2("CLNDUR^ABSPOSIH",.ZERR) ; /IHS/OIT/RAM ; 12 JUN 17 ; AND LOG IT IF AN ERROR OCCURS.
  1.  ;
  1.  Q
  1.  ;
  1. UPDRX(RXI,RXR,OVERDUR) ; update the prescription with the DUR 5.1 information
  1.  ; and the ABSP Data Input file with the appropriate value
  1.  ;
  1.  N FDA,ZERR  ; /IHS/OIT/RAM ; 12 JUN 17 ; ADD DBS CALL ERROR RETURN VARIABLE
  1.  ;
  1.  ; OVERDUR set within POSTINIT
  1.  ; RXR - rx refill IEN
  1.  ; RXI - rx IEN
  1.  ; OVERDUR - NCPDP 5.1 DUR segment pointer
  1.  ;
  1.  I '+$G(RXR) D    ;NOT a refill
  1.  . S FDA(52,RXI_",",9999999.13)=OVERDUR
  1.  . D FILE^DIE("","FDA","ZERR") ; /IHS/OIT/RAM ; 12 JUN 17 ; UPDATE DBS CALL TO ALLOW FOR ERROR RETURN.
  1.  . I $D(ZERR) D LOG^ABSPOSL2("UPDRX+13^ABSPOSIH",.ZERR) ; /IHS/OIT/RAM ; 12 JUN 17 ; AND LOG IT IF AN ERROR OCCURS.
  1.  ;
  1.  I +$G(RXR)  D    ;refill
  1.  . S FDA(52.1,RXR_","_RXI_",",9999999.13)=OVERDUR
  1.  . D FILE^DIE("","FDA","ZERR") ; /IHS/OIT/RAM ; 12 JUN 17 ; UPDATE DBS CALL TO ALLOW FOR ERROR RETURN.
  1.  . I $D(ZERR) D LOG^ABSPOSL2("UPDRX+18^ABSPOSIH",.ZERR) ; /IHS/OIT/RAM ; 12 JUN 17 ; AND LOG IT IF AN ERROR OCCURS.
  1.  ;
  1.  Q
  1.  ;
  1. NOCLM ;EP - called from ABSPOSI when the claims are NOT filed - we
  1.  ; still must clean up the empty records if they called upon
  1.  ; the DUR overrides
  1.  ;
  1.  N DURIEN,CLNDUR
  1.  S DURIEN=0
  1.  ;
  1.  F  S DURIEN=$O(^TMP("ABSPOSIH",$J,DURIEN)) Q:DURIEN=""  D
  1.  .  N CLNDUR,RXI,RXR,DURREC
  1.  .  S DURREC=$G(^TMP("ABSPOSIH",$J,DURIEN))
  1.  .  S RXI=$P(DURREC,"^")    ;internal RX number
  1.  .  S RXR=$P(DURREC,"^",2)  ;refill number
  1.  .  S CLNDUR=$$CHKDUR^ABSPOSD2(DURIEN)
  1.  .  D:$G(CLNDUR)="" UPDRX(RXI,RXR,CLNDUR)
  1.  ;
  1.  ;
  1.  Q