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

PSOERXP1.m

Go to the documentation of this file.
  1. PSOERXP1 ;ALB/BWF - eRx Patient Validation - ListMan ; 06 Apr 2023 1:00 PM
  1. ;;7.0;OUTPATIENT PHARMACY;**467,520,527,551,581,700,746**;DEC 1997;Build 106
  1. ;
  1. EN ; -- main entry point for PSO ERX HOLDING QUEUE
  1. N MBMSITE
  1. S MBMSITE=$S($$GET1^DIQ(59.7,1,102,"I")="MBM":1,1:0)
  1. D EN^VALM("PSO ERX PATIENT VALIDATION")
  1. Q
  1. ;
  1. LMHDR ; ListMan Header Code
  1. D SHOW^VALM,HDR^PSOERXP1
  1. S XQORM("??")="D HELP^VALM2,HDR^PSOERXP1"
  1. Q
  1. ;
  1. HDR ; -- header code
  1. N AMATCH,VPATIEN,VALUSER,VALDTTM,MATCH,HDR
  1. S AMATCH=$$GET1^DIQ(52.49,PSOIEN,1.6,"I"),VPATIEN=$$GET1^DIQ(52.49,PSOIEN,.05,"I")
  1. S VALUSER=$$GET1^DIQ(52.49,PSOIEN,1.13,"E"),VALDTTM=$$GET1^DIQ(52.49,PSOIEN,1.14,"I")
  1. S VALMHDR(1)="eRx Reference #: "_IOINHI_$$GET1^DIQ(52.49,PSOIEN,.01,"E")_IOINORM
  1. ;Only Displays Eligibility info if VistA Patient is selected
  1. I $G(VPATIEN) D
  1. . D INSTR^VALM1($S($G(MBMSITE):"ChampVA Rx Benefit: ",1:"Eligibility: ")_IOINHI_$$ELIG(VPATIEN)_IOINORM,$S($G(MBMSITE):41,1:30),2)
  1. S MATCH=$S(AMATCH=1:"AUTO-MATCHED",AMATCH=2:"AUTO-MATCHED/EDITED",VPATIEN:"MANUALLY-MATCHED",1:"")
  1. I VALUSER'="",MATCH'="" S MATCH=MATCH_" | VALIDATED by "_$E(VALUSER,1,19)_" on "_$$FMTE^XLFDT(VALDTTM,"2Y")
  1. I MATCH="" S MATCH="NOT MATCHED"
  1. S $E(MATCH,81)="" D INSTR^VALM1("Status: "_IOINHI_MATCH_IOINORM,1,3)
  1. S HDR="",$E(HDR,15)="ERX PATIENT",$E(HDR,40)="|",$E(HDR,54)="VISTA PATIENT"
  1. S $E(HDR,81)="" D INSTR^VALM1(IORVON_IOUON_HDR_IORVOFF_IOINORM,1,4)
  1. Q
  1. ;
  1. INIT ;
  1. ; - Resetting list to NORMAL video attributes
  1. D RESET^PSOERUT0()
  1. S LINE=0
  1. ;
  1. D SETPAT^PSOERUT0("LM",PSOIEN,,"PSOERXP1")
  1. ;
  1. S VALMCNT=LINE-1
  1. S EDTYP="P"
  1. ; - Saving NORMAL video attributes to be reset later
  1. I LINE>$G(LASTLINE) D
  1. . F I=($G(LASTLINE)+1):1:LINE D SAVE^VALM10(I)
  1. . S LASTLINE=LINE
  1. D VIDEO^PSOERUT0()
  1. Q
  1. ;
  1. HELP ; -- help code
  1. Q
  1. ;
  1. EXIT ; -- exit code
  1. K EDTYP,@VALMAR
  1. Q
  1. ;
  1. EXPND ; -- expand code
  1. Q
  1. ;
  1. ELIG(DFN) ; Eligibility Label (Different between VA Site and MbM)
  1. ; Input: DFN - Pointer to PATIENT File(#2)
  1. ;
  1. ;Eligibility Information
  1. N ELIG S ELIG=""
  1. I $G(DFN) D
  1. . I $$GET1^DIQ(59.7,1,102,"I")'="MBM" D
  1. . . D ELIG^VADPT S ELIG=$P(VAEL(1),"^",2)_$S(+VAEL(3):" (SC%: "_$P(VAEL(3),"^",2)_")",1:"")
  1. . E D
  1. . . S ELIG=$P($$CHVAELIG^PSOERXU9(DFN),"^",2)
  1. Q ELIG