PSOERXP1 ;ALB/BWF - eRx Patient Validation - ListMan ; 06 Apr 2023 1:00 PM
;;7.0;OUTPATIENT PHARMACY;**467,520,527,551,581,700,746**;DEC 1997;Build 106
;
EN ; -- main entry point for PSO ERX HOLDING QUEUE
N MBMSITE
S MBMSITE=$S($$GET1^DIQ(59.7,1,102,"I")="MBM":1,1:0)
D EN^VALM("PSO ERX PATIENT VALIDATION")
Q
;
LMHDR ; ListMan Header Code
D SHOW^VALM,HDR^PSOERXP1
S XQORM("??")="D HELP^VALM2,HDR^PSOERXP1"
Q
;
HDR ; -- header code
N AMATCH,VPATIEN,VALUSER,VALDTTM,MATCH,HDR
S AMATCH=$$GET1^DIQ(52.49,PSOIEN,1.6,"I"),VPATIEN=$$GET1^DIQ(52.49,PSOIEN,.05,"I")
S VALUSER=$$GET1^DIQ(52.49,PSOIEN,1.13,"E"),VALDTTM=$$GET1^DIQ(52.49,PSOIEN,1.14,"I")
S VALMHDR(1)="eRx Reference #: "_IOINHI_$$GET1^DIQ(52.49,PSOIEN,.01,"E")_IOINORM
;Only Displays Eligibility info if VistA Patient is selected
I $G(VPATIEN) D
. D INSTR^VALM1($S($G(MBMSITE):"ChampVA Rx Benefit: ",1:"Eligibility: ")_IOINHI_$$ELIG(VPATIEN)_IOINORM,$S($G(MBMSITE):41,1:30),2)
S MATCH=$S(AMATCH=1:"AUTO-MATCHED",AMATCH=2:"AUTO-MATCHED/EDITED",VPATIEN:"MANUALLY-MATCHED",1:"")
I VALUSER'="",MATCH'="" S MATCH=MATCH_" | VALIDATED by "_$E(VALUSER,1,19)_" on "_$$FMTE^XLFDT(VALDTTM,"2Y")
I MATCH="" S MATCH="NOT MATCHED"
S $E(MATCH,81)="" D INSTR^VALM1("Status: "_IOINHI_MATCH_IOINORM,1,3)
S HDR="",$E(HDR,15)="ERX PATIENT",$E(HDR,40)="|",$E(HDR,54)="VISTA PATIENT"
S $E(HDR,81)="" D INSTR^VALM1(IORVON_IOUON_HDR_IORVOFF_IOINORM,1,4)
Q
;
INIT ;
; - Resetting list to NORMAL video attributes
D RESET^PSOERUT0()
S LINE=0
;
D SETPAT^PSOERUT0("LM",PSOIEN,,"PSOERXP1")
;
S VALMCNT=LINE-1
S EDTYP="P"
; - Saving NORMAL video attributes to be reset later
I LINE>$G(LASTLINE) D
. F I=($G(LASTLINE)+1):1:LINE D SAVE^VALM10(I)
. S LASTLINE=LINE
D VIDEO^PSOERUT0()
Q
;
HELP ; -- help code
Q
;
EXIT ; -- exit code
K EDTYP,@VALMAR
Q
;
EXPND ; -- expand code
Q
;
ELIG(DFN) ; Eligibility Label (Different between VA Site and MbM)
; Input: DFN - Pointer to PATIENT File(#2)
;
;Eligibility Information
N ELIG S ELIG=""
I $G(DFN) D
. I $$GET1^DIQ(59.7,1,102,"I")'="MBM" D
. . D ELIG^VADPT S ELIG=$P(VAEL(1),"^",2)_$S(+VAEL(3):" (SC%: "_$P(VAEL(3),"^",2)_")",1:"")
. E D
. . S ELIG=$P($$CHVAELIG^PSOERXU9(DFN),"^",2)
Q ELIG
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSOERXP1 2287 printed Oct 16, 2024@18:29:39 Page 2
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
+2 ;
EN ; -- main entry point for PSO ERX HOLDING QUEUE
+1 NEW MBMSITE
+2 SET MBMSITE=$SELECT($$GET1^DIQ(59.7,1,102,"I")="MBM":1,1:0)
+3 DO EN^VALM("PSO ERX PATIENT VALIDATION")
+4 QUIT
+5 ;
LMHDR ; ListMan Header Code
+1 DO SHOW^VALM
DO HDR^PSOERXP1
+2 SET XQORM("??")="D HELP^VALM2,HDR^PSOERXP1"
+3 QUIT
+4 ;
HDR ; -- header code
+1 NEW AMATCH,VPATIEN,VALUSER,VALDTTM,MATCH,HDR
+2 SET AMATCH=$$GET1^DIQ(52.49,PSOIEN,1.6,"I")
SET VPATIEN=$$GET1^DIQ(52.49,PSOIEN,.05,"I")
+3 SET VALUSER=$$GET1^DIQ(52.49,PSOIEN,1.13,"E")
SET VALDTTM=$$GET1^DIQ(52.49,PSOIEN,1.14,"I")
+4 SET VALMHDR(1)="eRx Reference #: "_IOINHI_$$GET1^DIQ(52.49,PSOIEN,.01,"E")_IOINORM
+5 ;Only Displays Eligibility info if VistA Patient is selected
+6 IF $GET(VPATIEN)
Begin DoDot:1
+7 DO INSTR^VALM1($SELECT($GET(MBMSITE):"ChampVA Rx Benefit: ",1:"Eligibility: ")_IOINHI_$$ELIG(VPATIEN)_IOINORM,$SELECT($GET(MBMSITE):41,1:30),2)
End DoDot:1
+8 SET MATCH=$SELECT(AMATCH=1:"AUTO-MATCHED",AMATCH=2:"AUTO-MATCHED/EDITED",VPATIEN:"MANUALLY-MATCHED",1:"")
+9 IF VALUSER'=""
IF MATCH'=""
SET MATCH=MATCH_" | VALIDATED by "_$EXTRACT(VALUSER,1,19)_" on "_$$FMTE^XLFDT(VALDTTM,"2Y")
+10 IF MATCH=""
SET MATCH="NOT MATCHED"
+11 SET $EXTRACT(MATCH,81)=""
DO INSTR^VALM1("Status: "_IOINHI_MATCH_IOINORM,1,3)
+12 SET HDR=""
SET $EXTRACT(HDR,15)="ERX PATIENT"
SET $EXTRACT(HDR,40)="|"
SET $EXTRACT(HDR,54)="VISTA PATIENT"
+13 SET $EXTRACT(HDR,81)=""
DO INSTR^VALM1(IORVON_IOUON_HDR_IORVOFF_IOINORM,1,4)
+14 QUIT
+15 ;
INIT ;
+1 ; - Resetting list to NORMAL video attributes
+2 DO RESET^PSOERUT0()
+3 SET LINE=0
+4 ;
+5 DO SETPAT^PSOERUT0("LM",PSOIEN,,"PSOERXP1")
+6 ;
+7 SET VALMCNT=LINE-1
+8 SET EDTYP="P"
+9 ; - Saving NORMAL video attributes to be reset later
+10 IF LINE>$GET(LASTLINE)
Begin DoDot:1
+11 FOR I=($GET(LASTLINE)+1):1:LINE
DO SAVE^VALM10(I)
+12 SET LASTLINE=LINE
End DoDot:1
+13 DO VIDEO^PSOERUT0()
+14 QUIT
+15 ;
HELP ; -- help code
+1 QUIT
+2 ;
EXIT ; -- exit code
+1 KILL EDTYP,@VALMAR
+2 QUIT
+3 ;
EXPND ; -- expand code
+1 QUIT
+2 ;
ELIG(DFN) ; Eligibility Label (Different between VA Site and MbM)
+1 ; Input: DFN - Pointer to PATIENT File(#2)
+2 ;
+3 ;Eligibility Information
+4 NEW ELIG
SET ELIG=""
+5 IF $GET(DFN)
Begin DoDot:1
+6 IF $$GET1^DIQ(59.7,1,102,"I")'="MBM"
Begin DoDot:2
+7 DO ELIG^VADPT
SET ELIG=$PIECE(VAEL(1),"^",2)_$SELECT(+VAEL(3):" (SC%: "_$PIECE(VAEL(3),"^",2)_")",1:"")
End DoDot:2
+8 IF '$TEST
Begin DoDot:2
+9 SET ELIG=$PIECE($$CHVAELIG^PSOERXU9(DFN),"^",2)
End DoDot:2
End DoDot:1
+10 QUIT ELIG
