PSOERXP1.m

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 ---PSOERXP1   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