- 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 Feb 18, 2025@23:55:27 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