IBCNP ;AITC/CKB - Insurance Verification of Pharmacy policy ;23-APR-2025
;;2.0;INTEGRATED BILLING;**822**;21-MAR-94;Build 21
;;Per VA Directive 6402, this routine should not be modified.
;
; Reference to file #2 in ICR #10035
Q
;
PE ; -- main entry point for Pharmacy Eligibility
D FULL^VALM1
D EN^VALM("IBCNP PHARMACY ELIG")
S VALMBCK="R"
Q
;
HDR ; -- header code
N IBDOB,IBDOD,IBNAME
S IBDOB=$$GET1^DIQ(2,DFN_",",.03,"I") ;Date of Birth
S IBNAME=$E($$GET1^DIQ(2,DFN_",",.01),1,20)
;
S VALMHDR(1)="For: "_IBNAME_" "_$P($$PT^IBEFUNC(DFN),U,2)_" "_$$FMTE^XLFDT(IBDOB,"5DZ")
;
S IBDOD=$$GET1^DIQ(2,DFN_",",.351,"I") ;Date of Death
I IBDOD'="" S VALMHDR(1)=VALMHDR(1)_" DoD: "_$$FMTE^XLFDT(IBDOD,"5DZ")
;
S VALMHDR(2)=$$GET1^DIQ(2.312,$P(IBPPOL,U,4)_","_DFN,.01)_" Insurance Company"
Q
;
INIT ; -- init variables and list array
; Input: None
; Output: ^TMP("IBCNBLE",$J) - Body lines to display
K ^TMP("IBCNBLE",$J)
N RSPIEN
S VALMBCK="R",VALMBG=1,VALMCNT=0
D BLD
Q
;
BLD ; Build display of Pharmacy Eligibility data ^TMP("IBCNBLE",$J)
;Get the BPS REPONSE ien from field (#2.312,8.04) E1 DISPLAY ENTRY
S RSPIEN=$$GET1^DIQ(2.312,+$P(IBPPOL,U,4)_","_DFN_",",8.04,"I")
D EN1^IBCNBLE2(RSPIEN) ; Display Pharmacy Eligibility
Q
;
HELP ; -- help code
N X S X="?"
D DISP^XQORM1 W !!
Q
;
EXIT ; - exit list manager screen
K ^TMP("IBCNBLE",$J)
D CLEAN^VALM10,CLEAR^VALM1
S VALMBCK="R"
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBCNP 1482 printed Mar 25, 2026@15:40:59 Page 2
IBCNP ;AITC/CKB - Insurance Verification of Pharmacy policy ;23-APR-2025
+1 ;;2.0;INTEGRATED BILLING;**822**;21-MAR-94;Build 21
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;
+4 ; Reference to file #2 in ICR #10035
+5 QUIT
+6 ;
PE ; -- main entry point for Pharmacy Eligibility
+1 DO FULL^VALM1
+2 DO EN^VALM("IBCNP PHARMACY ELIG")
+3 SET VALMBCK="R"
+4 QUIT
+5 ;
HDR ; -- header code
+1 NEW IBDOB,IBDOD,IBNAME
+2 ;Date of Birth
SET IBDOB=$$GET1^DIQ(2,DFN_",",.03,"I")
+3 SET IBNAME=$EXTRACT($$GET1^DIQ(2,DFN_",",.01),1,20)
+4 ;
+5 SET VALMHDR(1)="For: "_IBNAME_" "_$PIECE($$PT^IBEFUNC(DFN),U,2)_" "_$$FMTE^XLFDT(IBDOB,"5DZ")
+6 ;
+7 ;Date of Death
SET IBDOD=$$GET1^DIQ(2,DFN_",",.351,"I")
+8 IF IBDOD'=""
SET VALMHDR(1)=VALMHDR(1)_" DoD: "_$$FMTE^XLFDT(IBDOD,"5DZ")
+9 ;
+10 SET VALMHDR(2)=$$GET1^DIQ(2.312,$PIECE(IBPPOL,U,4)_","_DFN,.01)_" Insurance Company"
+11 QUIT
+12 ;
INIT ; -- init variables and list array
+1 ; Input: None
+2 ; Output: ^TMP("IBCNBLE",$J) - Body lines to display
+3 KILL ^TMP("IBCNBLE",$JOB)
+4 NEW RSPIEN
+5 SET VALMBCK="R"
SET VALMBG=1
SET VALMCNT=0
+6 DO BLD
+7 QUIT
+8 ;
BLD ; Build display of Pharmacy Eligibility data ^TMP("IBCNBLE",$J)
+1 ;Get the BPS REPONSE ien from field (#2.312,8.04) E1 DISPLAY ENTRY
+2 SET RSPIEN=$$GET1^DIQ(2.312,+$PIECE(IBPPOL,U,4)_","_DFN_",",8.04,"I")
+3 ; Display Pharmacy Eligibility
DO EN1^IBCNBLE2(RSPIEN)
+4 QUIT
+5 ;
HELP ; -- help code
+1 NEW X
SET X="?"
+2 DO DISP^XQORM1
WRITE !!
+3 QUIT
+4 ;
EXIT ; - exit list manager screen
+1 KILL ^TMP("IBCNBLE",$JOB)
+2 DO CLEAN^VALM10
DO CLEAR^VALM1
+3 SET VALMBCK="R"
+4 QUIT
