PSOERXR1.m

PSOERXR1 ;ALB/BWF - eRx Provider Validation - ListMan ; 8/3/2016 5:14pm

 ;;7.0;OUTPATIENT PHARMACY;**467,520,527,581,545,700**;DEC 1997;Build 261

 ;

EN ; -- main entry point for PSO ERX HOLDING QUEUE

 D EN^VALM("PSO ERX PROVIDER VALIDATION")

 Q

 ;

LMHDR ; ListMan Header Code

 D SHOW^VALM,HDR^PSOERXR1

 S XQORM("??")="D HELP^VALM2,HDR^PSOERXR1"

 Q

 ;

HDR ; -- header code

 N AMATCH,VPROIEN,VALUSER,VALDTTM,MATCH,HDR

 S AMATCH=$$GET1^DIQ(52.49,PSOIEN,1.2,"I"),VPROIEN=$$GET1^DIQ(52.49,PSOIEN,2.3,"I")

 S VALUSER=$$GET1^DIQ(52.49,PSOIEN,1.8,"E"),VALDTTM=$$GET1^DIQ(52.49,PSOIEN,1.9,"I")

 S VALMHDR(1)="eRx Reference #: "_IOINHI_$$GET1^DIQ(52.49,PSOIEN,.01,"E")_IOINORM

 D INSTR^VALM1("eRx Patient: "_IOINHI_$$GET1^DIQ(52.49,PSOIEN,.04,"E")_IOINORM,32,2)

 S MATCH=$S(AMATCH=1:"AUTO-MATCHED",AMATCH=2:"AUTO-MATCHED/EDITED",VPROIEN:"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 PROVIDER",$E(HDR,40)="|",$E(HDR,54)="VISTA PROVIDER"

 S $E(HDR,81)="" D INSTR^VALM1(IORVON_IOUON_HDR_IORVOFF_IOINORM,1,4)

 Q

 ;

INIT ;

 Q:'$G(PSOIEN)  K ^XTMP("PSOERXR1",$J)

 ; - Resetting list to NORMAL video attributes

 D RESET^PSOERUT0()

 S LINE=1

 ;

 D SETPROV^PSOERUT1("LM",PSOIEN,,"PSOERXR1")

 ;

 S VALMCNT=LINE-1

 S EDTYP="PR"

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

 S X="?" D DISP^XQORM1 W !!

 Q

 ;

EXIT ; -- exit code

 K EDTYP,@VALMAR

 Q

 ;

EXPND ; -- expand code

 Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---PSOERXR1   1767     printed  Apr 09, 2024@21:26:55                                                                                                                                                                                                    Page 2

PSOERXR1  ;ALB/BWF - eRx Provider Validation - ListMan ; 8/3/2016 5:14pm

 +1       ;;7.0;OUTPATIENT PHARMACY;**467,520,527,581,545,700**;DEC 1997;Build 261

 +2       ;

EN        ; -- main entry point for PSO ERX HOLDING QUEUE

 +1        DO EN^VALM("PSO ERX PROVIDER VALIDATION")

 +2        QUIT 

 +3       ;

LMHDR     ; ListMan Header Code

 +1        DO SHOW^VALM

           DO HDR^PSOERXR1

 +2        SET XQORM("??")="D HELP^VALM2,HDR^PSOERXR1"

 +3        QUIT 

 +4       ;

HDR       ; -- header code

 +1        NEW AMATCH,VPROIEN,VALUSER,VALDTTM,MATCH,HDR

 +2        SET AMATCH=$$GET1^DIQ(52.49,PSOIEN,1.2,"I")

           SET VPROIEN=$$GET1^DIQ(52.49,PSOIEN,2.3,"I")

 +3        SET VALUSER=$$GET1^DIQ(52.49,PSOIEN,1.8,"E")

           SET VALDTTM=$$GET1^DIQ(52.49,PSOIEN,1.9,"I")

 +4        SET VALMHDR(1)="eRx Reference #: "_IOINHI_$$GET1^DIQ(52.49,PSOIEN,.01,"E")_IOINORM

 +5        DO INSTR^VALM1("eRx Patient: "_IOINHI_$$GET1^DIQ(52.49,PSOIEN,.04,"E")_IOINORM,32,2)

 +6        SET MATCH=$SELECT(AMATCH=1:"AUTO-MATCHED",AMATCH=2:"AUTO-MATCHED/EDITED",VPROIEN:"MANUALLY-MATCHED",1:"")

 +7        IF VALUSER'=""

               IF MATCH'=""

                   SET MATCH=MATCH_" | VALIDATED by "_$EXTRACT(VALUSER,1,19)_" on "_$$FMTE^XLFDT(VALDTTM,"2Y")

 +8        IF MATCH=""

               SET MATCH="NOT MATCHED"

 +9        SET $EXTRACT(MATCH,81)=""

           DO INSTR^VALM1("Status: "_IOINHI_MATCH_IOINORM,1,3)

 +10       SET HDR=""

           SET $EXTRACT(HDR,15)="ERX PROVIDER"

           SET $EXTRACT(HDR,40)="|"

           SET $EXTRACT(HDR,54)="VISTA PROVIDER"

 +11       SET $EXTRACT(HDR,81)=""

           DO INSTR^VALM1(IORVON_IOUON_HDR_IORVOFF_IOINORM,1,4)

 +12       QUIT 

 +13      ;

INIT      ;

 +1        if '$GET(PSOIEN)

               QUIT 

           KILL ^XTMP("PSOERXR1",$JOB)

 +2       ; - Resetting list to NORMAL video attributes

 +3        DO RESET^PSOERUT0()

 +4        SET LINE=1

 +5       ;

 +6        DO SETPROV^PSOERUT1("LM",PSOIEN,,"PSOERXR1")

 +7       ;

 +8        SET VALMCNT=LINE-1

 +9        SET EDTYP="PR"

 +10      ; - Saving NORMAL video attributes to be reset later

 +11       IF LINE>$GET(LASTLINE)

               Begin DoDot:1

 +12               FOR I=($GET(LASTLINE)+1):1:LINE

                       DO SAVE^VALM10(I)

 +13               SET LASTLINE=LINE

               End DoDot:1

 +14       DO VIDEO^PSOERUT0()

 +15       QUIT 

HELP      ; -- help code

 +1        SET X="?"

           DO DISP^XQORM1

           WRITE !!

 +2        QUIT 

 +3       ;

EXIT      ; -- exit code

 +1        KILL EDTYP,@VALMAR

 +2        QUIT 

 +3       ;

EXPND     ; -- expand code

 +1        QUIT