PSOERUT1 ;ALB/MFR - eRx Provider - ListMan Utilities; 06/25/2023 5:14pm
;;7.0;OUTPATIENT PHARMACY;**700,743,746**;DEC 1997;Build 106
;
SETPROV(MODE,ERXIEN,VAPRVIEN,NMSPC,PENFLG,SDFLG) ; Set ListMan Side-By-Side Section for Provider
;Input: MODE - Display Mode: "RS": Roll & Scroll | "LM": ListMan
; ERXIEN - Pointer to ERX HOLDING QUEUE file (#52.49)
; VAPRVIEN - Matched/Suggested VistA Patient - Pointer to PATIENT file (#2)
; (o)NMSPC - ListMan Temp Global Namespace (e.g., "PSOERXP1") - Required for LM Mode only
; (o)PENFLG - Pending Order Flag - 1: Pending Order Interface | 0: eRx Holding Queue Interface
; (o)SDFLG - Single eRx View/Display Flag - 1: Single eRx View/Display Interface | 0: eRx Holding Queue Interface
; Input Global Variable: LINE - Current ListMan Line # (Default)
; Output Global Variable: (ListMan Mode ONly)
; REVLN - Array Indicating Reverse Video for Line, position and size of the string
; HIGLN - Array Indicating Highlight for Line, position and size of the string
;
S:'$G(LINE) LINE=1 S NMSPC=$G(NMSPC)
N PARVDAT,EXPIEN,EXPIENS,EXPNM,EXPDOB,EXPSSN,EXPADD,EXPGEN,EXPCTY,EXPST,EXPZIP,HFIEN,EXPHPH,CPIEN,EXPCPH,LINETXT
N EXPADD1,EXPADD2,EXPAGNT,EXPDEA,EXPFN,EXPLIC,EXPNPI,EXPSUPER,EXPWPH,FNIEN,MANVAL,PRVDAT,VAPADD1,VAPADD2,VAPCIT,DEAEXP
N VAPDEA,VAPFAX,VAPIENS,VAPLIC,VAPNM,VAPNPI,VAPROV,VAPST,VAPTEL,VAPZIP,WPIEN,SEPLN,VAPDEAEX,VALBY,VALDTTM,AGENT,SUPERVSR
N NLOOP,AGENTARY,TLOOP,TFIRST,SUPERARY,SIEN,TYPE,VALUE,PRFAX,PRTEL,IENS,S2017,DFN,X,XE,XV,SPECLTY,CLNC,VPROIEN
;
;eRx Provider Data
S LINETXT=""
S S2017=$$GET1^DIQ(52.49,ERXIEN,312.1)
S EXPIEN=$$GET1^DIQ(52.49,ERXIEN,2.1,"I")
I 'EXPIEN S EXPIEN=$$GETPROV^PSOERXU5(ERXIEN)
S EXPIENS=EXPIEN_","
D GETS^DIQ(52.48,EXPIENS,"**","E","PRVDAT")
S EXPNM=$G(PRVDAT(52.48,EXPIENS,.01,"E"))
S EXPNPI=$G(PRVDAT(52.48,EXPIENS,1.5,"E"))
S EXPDEA=$G(PRVDAT(52.48,EXPIENS,1.6,"E"))
S EXPLIC=$G(PRVDAT(52.48,EXPIENS,1.8,"E"))
S SPECLTY=$G(PRVDAT(52.48,EXPIENS,1.2,"E"))
S EXPAGNT=$G(PRVDAT(52.48,EXPIENS,5.1,"E"))
I $L(EXPAGNT) D
. S EXPAGNT=EXPAGNT_", "_$G(PRVDAT(52.48,EXPIENS,5.2,"E"))_" "_$G(PRVDAT(52.48,EXPIENS,5.3,"E"))
S CLNC=$G(PRVDAT(52.48,EXPIENS,2.1,"E"))
I CLNC="" S CLNC=$G(PRVDAT(52.48,EXPIENS,18.6,"E"))
S EXPSUPER=$$GET1^DIQ(52.49,ERXIEN,2.6,"E")
S EXPADD1=$G(PRVDAT(52.48,EXPIENS,4.1,"E"))
S EXPADD2=$G(PRVDAT(52.48,EXPIENS,4.2,"E"))
S EXPCTY=$G(PRVDAT(52.48,EXPIENS,4.3,"E"))
S EXPST=$$GET1^DIQ(5,$$GET1^DIQ(52.48,EXPIENS,4.4,"I"),1)
S EXPZIP=$G(PRVDAT(52.48,EXPIENS,4.5,"E")),EXPZIP=$E(EXPZIP,1,5)
S WPIEN=$O(^PS(52.48,EXPIEN,3,"C","WP",0))
S SIEN=0
F S SIEN=$O(^PS(52.48,EXPIEN,3,SIEN)) Q:'SIEN D
. S IENS=SIEN_","_EXPIEN_","
. S TYPE=$$GET1^DIQ(52.483,IENS,.02)
. S VALUE=$$GET1^DIQ(52.483,IENS,.01)
. I TYPE="FAX" S PRFAX=VALUE
. I TYPE="TELEPHONE" S PRTEL=VALUE
I S2017 D
. S EXPNPI=$$GET1^DIQ(52.48,EXPIEN,15.1)
. S EXPDEA=$$GET1^DIQ(52.48,EXPIEN,14.5)
. S EXPLIC=$$GET1^DIQ(52.48,EXPIEN,14.1)
. S PRTEL=$$COMMVAL^PSOERXU5(EXPIEN,52.48,11,"PT",1)
. S PRFAX=$$COMMVAL^PSOERXU5(EXPIEN,52.48,11,"F",1)
;
;VistA Provider Data
I '$G(VAPRVIEN) S VAPRVIEN=+$$GET1^DIQ(52.49,ERXIEN,2.3,"I")
S (VAPNM,VAPADD1,VAPADD2,VAPCIT,VAPST,VAPZIP,VAPNPI,VAPDEA,VAPLIC,VAPTEL,VAPFAX)=""
S MANVAL=$$GET1^DIQ(52.49,ERXIEN,1.3,"I")
S VALBY=$$GET1^DIQ(52.49,ERXIEN,1.8,"E")
S VALDTTM=$$GET1^DIQ(52.49,ERXIEN,1.9,"E")
I VAPRVIEN D
. S VAPIENS=VAPRVIEN_","
. D GETS^DIQ(200,VAPIENS,".01;.111;.112;.113;.114;.115;.116;.132;.136;41.99;53.2;54.2","IE","VAPROV")
. S VAPNM=$G(VAPROV(200,VAPIENS,.01,"E"))
. S VAPADD1=$G(VAPROV(200,VAPIENS,.111,"E"))
. S VAPADD2=$G(VAPROV(200,VAPIENS,.112,"E"))
. S VAPCIT=$G(VAPROV(200,VAPIENS,.114,"E"))
. S VAPST=$$GET1^DIQ(5,$$GET1^DIQ(200,VAPRVIEN,.115,"I"),1)
. S VAPZIP=$G(VAPROV(200,VAPIENS,.116,"E"))
. S VAPNPI=$G(VAPROV(200,VAPIENS,41.99,"E"))
. S VAPDEA=$P($$VADEA^PSOERXU8(VAPRVIEN,ERXIEN),"^",2)
. S VAPDEAEX=$$DEAXDT^XUSER(VAPDEA) I VAPDEAEX,VAPDEAEX<DT S DEAEXP=1
. S VAPLIC=$G(VAPROV(200,VAPIENS,54.2,"E"))
. S VAPTEL=$G(VAPROV(200,VAPIENS,.132,"E"))
. S VAPFAX=$G(VAPROV(200,VAPIENS,.136,"E"))
. S MANVAL=$$GET1^DIQ(52.49,ERXIEN,1.3,"I")
;
; - Provider Matching Header Line
I $G(PENFLG)!($G(SDFLG)) D
. N AMATCH,VPATIEN,VALUSER,VALDTTM,MATCH,HDR
. S AMATCH=$$GET1^DIQ(52.49,ERXIEN,1.2,"I"),VPROIEN=$$GET1^DIQ(52.49,ERXIEN,2.3,"I")
. S VALUSER=$$GET1^DIQ(52.49,ERXIEN,1.8,"E"),VALDTTM=$$GET1^DIQ(52.49,ERXIEN,1.9,"I")
. I $$GET1^DIQ(52.49,ERXIEN,.08,"I")="RE",'VALDTTM D
. . S MATCH="PREVIOUSLY MATCHED/VALIDATED (RENEWAL)"
. E D
. . 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 MATCH="PROVIDER "_MATCH I $L(MATCH)>78 S MATCH=$E(MATCH,1,78)
. S HDR="",$E(HDR,(80-$L(MATCH))\2+1)=MATCH,$E(HDR,81)=""
. S $E(MATCH,81)=""
. S UNDERLN(LINE,1)=100 I HDR["/EDITED" S BLINKLN(LINE,$F(HDR,"/EDITED")-6)=6
. D ADDLINE^PSOERUT0(MODE,NMSPC,HDR,"")
;
;Side-by-side Display
S XE="Name: "_$$COMPARE^PSOERUT0(MODE,$E(EXPNM,1,33),VAPNM,7,,,'VAPRVIEN)
S XV="|Name: "_$$COMPARE^PSOERUT0(MODE,VAPNM,EXPNM,47)
D ADDLINE^PSOERUT0(MODE,NMSPC,XE,XV)
I $L(EXPNM)>33 D
. S XE=" "_$$COMPARE^PSOERUT0(MODE,$E(EXPNM,34,67),"",7,,,'VAPRVIEN),XV="|"
. D ADDLINE^PSOERUT0(MODE,NMSPC,XE,XV)
S XE="NPI : "_$$COMPARE^PSOERUT0(MODE,EXPNPI,VAPNPI,7,,,'VAPRVIEN)
S XV="|NPI : "_$$COMPARE^PSOERUT0(MODE,VAPNPI,EXPNPI,47)
D ADDLINE^PSOERUT0(MODE,NMSPC,XE,XV)
S XE="DEA : "_$$COMPARE^PSOERUT0(MODE,EXPDEA,VAPDEA,7,,,'VAPRVIEN)
S XV="|DEA : "_$$COMPARE^PSOERUT0(MODE,VAPDEA,EXPDEA,47)
I $G(VAPDEAEX)'="" D
. S $E(XV,20)="DEA EXP: "_$$COMPARE^PSOERUT0(MODE,$$FMTE^XLFDT(VAPDEAEX,"2Y"),$S($G(DEAEXP):"",1:$$FMTE^XLFDT(VAPDEAEX,"2Y")),68)
D ADDLINE^PSOERUT0(MODE,NMSPC,XE,XV)
;
; Clinic (Wraps only in the Validate Provider Screen)
S XE="Clinic: "_$$COMPARE^PSOERUT0(MODE,$E($G(CLNC),1,31),$E($G(CLNC),1,31),9)
S XV="|" D ADDLINE^PSOERUT0(MODE,NMSPC,XE,XV)
I '$G(SDFLG),$L(CLNC)>31 D
. S XE="",$E(XE,9)=$$COMPARE^PSOERUT0(MODE,$E($G(CLNC),32,62),$E($G(CLNC),32,62),9)
. S XV="|" D ADDLINE^PSOERUT0(MODE,NMSPC,XE,XV)
;
I $G(PENFLG)!$G(SDFLG) Q
;
I $G(EXPLIC)'=""!($G(VAPLIC)'="") D
. S XE="State Lic: "_$$COMPARE^PSOERUT0(MODE,EXPLIC,VAPLIC,12,,,'VAPRVIEN)
. S XV="|State Lic: "_$$COMPARE^PSOERUT0(MODE,VAPLIC,EXPLIC,52)
. D ADDLINE^PSOERUT0(MODE,NMSPC,XE,XV)
; Address
D BLANKLN^PSOERUT0(MODE)
S XE="Address:",XV="|Address:" D ADDLINE^PSOERUT0(MODE,NMSPC,XE,XV)
S XE=" "_$$COMPARE^PSOERUT0(MODE,EXPADD1,VAPADD1,2,,,'VAPRVIEN)
S XV="| "_$$COMPARE^PSOERUT0(MODE,VAPADD1,EXPADD1,42) D ADDLINE^PSOERUT0(MODE,NMSPC,XE,XV)
I EXPADD2'=""!(VAPADD2'="") D
. S XE=" "_$$COMPARE^PSOERUT0(MODE,EXPADD2,VAPADD2,2,,,'VAPRVIEN)
. S XV="| "_$$COMPARE^PSOERUT0(MODE,VAPADD2,EXPADD2,42) D ADDLINE^PSOERUT0(MODE,NMSPC,XE,XV)
S XE=" "_$$COMPARE^PSOERUT0(MODE,EXPCTY,VAPCIT,2,,,'VAPRVIEN)
S XE=XE_$S(EXPCTY'="":",",1:"")_$$COMPARE^PSOERUT0(MODE,EXPST,VAPST,$L(XE)+2,,,'VAPRVIEN)
S XE=XE_" "_$$COMPARE^PSOERUT0(MODE,EXPZIP,VAPZIP,$L(XE)+3,1,,'VAPRVIEN)
S XV="| "_$$COMPARE^PSOERUT0(MODE,VAPCIT,EXPCTY,42)
S XV=XV_$S(VAPCIT'="":",",1:"")_$$COMPARE^PSOERUT0(MODE,VAPST,EXPST,$L(XV)+41)
S XV=XV_" "_$$COMPARE^PSOERUT0(MODE,VAPZIP,EXPZIP,$L(XV)+42,1)
D ADDLINE^PSOERUT0(MODE,NMSPC,XE,XV)
; Communication #'s
S XE="Tel: "_$$COMPARE^PSOERUT0(MODE,$G(PRTEL),$G(VAPTEL),6,,,'VAPRVIEN)
S XV="|Tel: "_$$COMPARE^PSOERUT0(MODE,$G(VAPTEL),$G(PRTEL),46)
D ADDLINE^PSOERUT0(MODE,NMSPC,XE,XV)
I $G(PRFAX)'=""!($G(VAPFAX)'="") D
. S XE="Fax: "_$$COMPARE^PSOERUT0(MODE,$G(PRFAX),$G(VAPFAX),6,,,'VAPRVIEN)
. S XV="|Fax: "_$$COMPARE^PSOERUT0(MODE,$G(VAPFAX),$G(PRFAX),46)
. D ADDLINE^PSOERUT0(MODE,NMSPC,XE,XV)
;
I $G(EXPAGNT)'=""!($G(EXPSUPER)'="") D
. D BLANKLN^PSOERUT0(MODE)
;
I $G(EXPAGNT)'="" D
. D TXT2ARY^PSOERXD1(.AGENTARY,EXPAGNT,,65)
. S NLOOP=0 F S NLOOP=$O(AGENTARY(NLOOP)) Q:'NLOOP D
. . S AGENT=$E($G(AGENTARY(NLOOP)),1,32)
. . S XE="Agent: "_$$COMPARE^PSOERUT0(MODE,AGENT,AGENT,8,,,'VAPRVIEN)
. . S XV="| " D ADDLINE^PSOERUT0(MODE,NMSPC,XE,XV)
I $G(EXPSUPER)'="" D
. D TXT2ARY^PSOERXD1(.SUPERARY,EXPSUPER,,65)
. S TLOOP=0 F S TLOOP=$O(SUPERARY(TLOOP)) Q:'TLOOP D
. . S SUPERVSR=$E($G(SUPERARY(TLOOP)),1,27)
. . S XE="Supervisor: "_$$COMPARE^PSOERUT0(MODE,SUPERVSR,SUPERVSR,13,,,'VAPRVIEN)
. . S XV="| " D ADDLINE^PSOERUT0(MODE,NMSPC,XE,XV)
D BLANKLN^PSOERUT0(MODE)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSOERUT1 8734 printed Oct 16, 2024@18:28:41 Page 2
PSOERUT1 ;ALB/MFR - eRx Provider - ListMan Utilities; 06/25/2023 5:14pm
+1 ;;7.0;OUTPATIENT PHARMACY;**700,743,746**;DEC 1997;Build 106
+2 ;
SETPROV(MODE,ERXIEN,VAPRVIEN,NMSPC,PENFLG,SDFLG) ; Set ListMan Side-By-Side Section for Provider
+1 ;Input: MODE - Display Mode: "RS": Roll & Scroll | "LM": ListMan
+2 ; ERXIEN - Pointer to ERX HOLDING QUEUE file (#52.49)
+3 ; VAPRVIEN - Matched/Suggested VistA Patient - Pointer to PATIENT file (#2)
+4 ; (o)NMSPC - ListMan Temp Global Namespace (e.g., "PSOERXP1") - Required for LM Mode only
+5 ; (o)PENFLG - Pending Order Flag - 1: Pending Order Interface | 0: eRx Holding Queue Interface
+6 ; (o)SDFLG - Single eRx View/Display Flag - 1: Single eRx View/Display Interface | 0: eRx Holding Queue Interface
+7 ; Input Global Variable: LINE - Current ListMan Line # (Default)
+8 ; Output Global Variable: (ListMan Mode ONly)
+9 ; REVLN - Array Indicating Reverse Video for Line, position and size of the string
+10 ; HIGLN - Array Indicating Highlight for Line, position and size of the string
+11 ;
+12 if '$GET(LINE)
SET LINE=1
SET NMSPC=$GET(NMSPC)
+13 NEW PARVDAT,EXPIEN,EXPIENS,EXPNM,EXPDOB,EXPSSN,EXPADD,EXPGEN,EXPCTY,EXPST,EXPZIP,HFIEN,EXPHPH,CPIEN,EXPCPH,LINETXT
+14 NEW EXPADD1,EXPADD2,EXPAGNT,EXPDEA,EXPFN,EXPLIC,EXPNPI,EXPSUPER,EXPWPH,FNIEN,MANVAL,PRVDAT,VAPADD1,VAPADD2,VAPCIT,DEAEXP
+15 NEW VAPDEA,VAPFAX,VAPIENS,VAPLIC,VAPNM,VAPNPI,VAPROV,VAPST,VAPTEL,VAPZIP,WPIEN,SEPLN,VAPDEAEX,VALBY,VALDTTM,AGENT,SUPERVSR
+16 NEW NLOOP,AGENTARY,TLOOP,TFIRST,SUPERARY,SIEN,TYPE,VALUE,PRFAX,PRTEL,IENS,S2017,DFN,X,XE,XV,SPECLTY,CLNC,VPROIEN
+17 ;
+18 ;eRx Provider Data
+19 SET LINETXT=""
+20 SET S2017=$$GET1^DIQ(52.49,ERXIEN,312.1)
+21 SET EXPIEN=$$GET1^DIQ(52.49,ERXIEN,2.1,"I")
+22 IF 'EXPIEN
SET EXPIEN=$$GETPROV^PSOERXU5(ERXIEN)
+23 SET EXPIENS=EXPIEN_","
+24 DO GETS^DIQ(52.48,EXPIENS,"**","E","PRVDAT")
+25 SET EXPNM=$GET(PRVDAT(52.48,EXPIENS,.01,"E"))
+26 SET EXPNPI=$GET(PRVDAT(52.48,EXPIENS,1.5,"E"))
+27 SET EXPDEA=$GET(PRVDAT(52.48,EXPIENS,1.6,"E"))
+28 SET EXPLIC=$GET(PRVDAT(52.48,EXPIENS,1.8,"E"))
+29 SET SPECLTY=$GET(PRVDAT(52.48,EXPIENS,1.2,"E"))
+30 SET EXPAGNT=$GET(PRVDAT(52.48,EXPIENS,5.1,"E"))
+31 IF $LENGTH(EXPAGNT)
Begin DoDot:1
+32 SET EXPAGNT=EXPAGNT_", "_$GET(PRVDAT(52.48,EXPIENS,5.2,"E"))_" "_$GET(PRVDAT(52.48,EXPIENS,5.3,"E"))
End DoDot:1
+33 SET CLNC=$GET(PRVDAT(52.48,EXPIENS,2.1,"E"))
+34 IF CLNC=""
SET CLNC=$GET(PRVDAT(52.48,EXPIENS,18.6,"E"))
+35 SET EXPSUPER=$$GET1^DIQ(52.49,ERXIEN,2.6,"E")
+36 SET EXPADD1=$GET(PRVDAT(52.48,EXPIENS,4.1,"E"))
+37 SET EXPADD2=$GET(PRVDAT(52.48,EXPIENS,4.2,"E"))
+38 SET EXPCTY=$GET(PRVDAT(52.48,EXPIENS,4.3,"E"))
+39 SET EXPST=$$GET1^DIQ(5,$$GET1^DIQ(52.48,EXPIENS,4.4,"I"),1)
+40 SET EXPZIP=$GET(PRVDAT(52.48,EXPIENS,4.5,"E"))
SET EXPZIP=$EXTRACT(EXPZIP,1,5)
+41 SET WPIEN=$ORDER(^PS(52.48,EXPIEN,3,"C","WP",0))
+42 SET SIEN=0
+43 FOR
SET SIEN=$ORDER(^PS(52.48,EXPIEN,3,SIEN))
if 'SIEN
QUIT
Begin DoDot:1
+44 SET IENS=SIEN_","_EXPIEN_","
+45 SET TYPE=$$GET1^DIQ(52.483,IENS,.02)
+46 SET VALUE=$$GET1^DIQ(52.483,IENS,.01)
+47 IF TYPE="FAX"
SET PRFAX=VALUE
+48 IF TYPE="TELEPHONE"
SET PRTEL=VALUE
End DoDot:1
+49 IF S2017
Begin DoDot:1
+50 SET EXPNPI=$$GET1^DIQ(52.48,EXPIEN,15.1)
+51 SET EXPDEA=$$GET1^DIQ(52.48,EXPIEN,14.5)
+52 SET EXPLIC=$$GET1^DIQ(52.48,EXPIEN,14.1)
+53 SET PRTEL=$$COMMVAL^PSOERXU5(EXPIEN,52.48,11,"PT",1)
+54 SET PRFAX=$$COMMVAL^PSOERXU5(EXPIEN,52.48,11,"F",1)
End DoDot:1
+55 ;
+56 ;VistA Provider Data
+57 IF '$GET(VAPRVIEN)
SET VAPRVIEN=+$$GET1^DIQ(52.49,ERXIEN,2.3,"I")
+58 SET (VAPNM,VAPADD1,VAPADD2,VAPCIT,VAPST,VAPZIP,VAPNPI,VAPDEA,VAPLIC,VAPTEL,VAPFAX)=""
+59 SET MANVAL=$$GET1^DIQ(52.49,ERXIEN,1.3,"I")
+60 SET VALBY=$$GET1^DIQ(52.49,ERXIEN,1.8,"E")
+61 SET VALDTTM=$$GET1^DIQ(52.49,ERXIEN,1.9,"E")
+62 IF VAPRVIEN
Begin DoDot:1
+63 SET VAPIENS=VAPRVIEN_","
+64 DO GETS^DIQ(200,VAPIENS,".01;.111;.112;.113;.114;.115;.116;.132;.136;41.99;53.2;54.2","IE","VAPROV")
+65 SET VAPNM=$GET(VAPROV(200,VAPIENS,.01,"E"))
+66 SET VAPADD1=$GET(VAPROV(200,VAPIENS,.111,"E"))
+67 SET VAPADD2=$GET(VAPROV(200,VAPIENS,.112,"E"))
+68 SET VAPCIT=$GET(VAPROV(200,VAPIENS,.114,"E"))
+69 SET VAPST=$$GET1^DIQ(5,$$GET1^DIQ(200,VAPRVIEN,.115,"I"),1)
+70 SET VAPZIP=$GET(VAPROV(200,VAPIENS,.116,"E"))
+71 SET VAPNPI=$GET(VAPROV(200,VAPIENS,41.99,"E"))
+72 SET VAPDEA=$PIECE($$VADEA^PSOERXU8(VAPRVIEN,ERXIEN),"^",2)
+73 SET VAPDEAEX=$$DEAXDT^XUSER(VAPDEA)
IF VAPDEAEX
IF VAPDEAEX<DT
SET DEAEXP=1
+74 SET VAPLIC=$GET(VAPROV(200,VAPIENS,54.2,"E"))
+75 SET VAPTEL=$GET(VAPROV(200,VAPIENS,.132,"E"))
+76 SET VAPFAX=$GET(VAPROV(200,VAPIENS,.136,"E"))
+77 SET MANVAL=$$GET1^DIQ(52.49,ERXIEN,1.3,"I")
End DoDot:1
+78 ;
+79 ; - Provider Matching Header Line
+80 IF $GET(PENFLG)!($GET(SDFLG))
Begin DoDot:1
+81 NEW AMATCH,VPATIEN,VALUSER,VALDTTM,MATCH,HDR
+82 SET AMATCH=$$GET1^DIQ(52.49,ERXIEN,1.2,"I")
SET VPROIEN=$$GET1^DIQ(52.49,ERXIEN,2.3,"I")
+83 SET VALUSER=$$GET1^DIQ(52.49,ERXIEN,1.8,"E")
SET VALDTTM=$$GET1^DIQ(52.49,ERXIEN,1.9,"I")
+84 IF $$GET1^DIQ(52.49,ERXIEN,.08,"I")="RE"
IF 'VALDTTM
Begin DoDot:2
+85 SET MATCH="PREVIOUSLY MATCHED/VALIDATED (RENEWAL)"
End DoDot:2
+86 IF '$TEST
Begin DoDot:2
+87 SET MATCH=$SELECT(AMATCH=1:"AUTO-MATCHED",AMATCH=2:"AUTO-MATCHED/EDITED",VPROIEN:"MANUALLY-MATCHED",1:"")
+88 IF VALUSER'=""
IF MATCH'=""
SET MATCH=MATCH_" | VALIDATED by "_$EXTRACT(VALUSER,1,19)_" on "_$$FMTE^XLFDT(VALDTTM,"2Y")
+89 IF MATCH=""
SET MATCH="NOT MATCHED"
End DoDot:2
+90 SET MATCH="PROVIDER "_MATCH
IF $LENGTH(MATCH)>78
SET MATCH=$EXTRACT(MATCH,1,78)
+91 SET HDR=""
SET $EXTRACT(HDR,(80-$LENGTH(MATCH))\2+1)=MATCH
SET $EXTRACT(HDR,81)=""
+92 SET $EXTRACT(MATCH,81)=""
+93 SET UNDERLN(LINE,1)=100
IF HDR["/EDITED"
SET BLINKLN(LINE,$FIND(HDR,"/EDITED")-6)=6
+94 DO ADDLINE^PSOERUT0(MODE,NMSPC,HDR,"")
End DoDot:1
+95 ;
+96 ;Side-by-side Display
+97 SET XE="Name: "_$$COMPARE^PSOERUT0(MODE,$EXTRACT(EXPNM,1,33),VAPNM,7,,,'VAPRVIEN)
+98 SET XV="|Name: "_$$COMPARE^PSOERUT0(MODE,VAPNM,EXPNM,47)
+99 DO ADDLINE^PSOERUT0(MODE,NMSPC,XE,XV)
+100 IF $LENGTH(EXPNM)>33
Begin DoDot:1
+101 SET XE=" "_$$COMPARE^PSOERUT0(MODE,$EXTRACT(EXPNM,34,67),"",7,,,'VAPRVIEN)
SET XV="|"
+102 DO ADDLINE^PSOERUT0(MODE,NMSPC,XE,XV)
End DoDot:1
+103 SET XE="NPI : "_$$COMPARE^PSOERUT0(MODE,EXPNPI,VAPNPI,7,,,'VAPRVIEN)
+104 SET XV="|NPI : "_$$COMPARE^PSOERUT0(MODE,VAPNPI,EXPNPI,47)
+105 DO ADDLINE^PSOERUT0(MODE,NMSPC,XE,XV)
+106 SET XE="DEA : "_$$COMPARE^PSOERUT0(MODE,EXPDEA,VAPDEA,7,,,'VAPRVIEN)
+107 SET XV="|DEA : "_$$COMPARE^PSOERUT0(MODE,VAPDEA,EXPDEA,47)
+108 IF $GET(VAPDEAEX)'=""
Begin DoDot:1
+109 SET $EXTRACT(XV,20)="DEA EXP: "_$$COMPARE^PSOERUT0(MODE,$$FMTE^XLFDT(VAPDEAEX,"2Y"),$SELECT($GET(DEAEXP):"",1:$$FMTE^XLFDT(VAPDEAEX,"2Y")),68)
End DoDot:1
+110 DO ADDLINE^PSOERUT0(MODE,NMSPC,XE,XV)
+111 ;
+112 ; Clinic (Wraps only in the Validate Provider Screen)
+113 SET XE="Clinic: "_$$COMPARE^PSOERUT0(MODE,$EXTRACT($GET(CLNC),1,31),$EXTRACT($GET(CLNC),1,31),9)
+114 SET XV="|"
DO ADDLINE^PSOERUT0(MODE,NMSPC,XE,XV)
+115 IF '$GET(SDFLG)
IF $LENGTH(CLNC)>31
Begin DoDot:1
+116 SET XE=""
SET $EXTRACT(XE,9)=$$COMPARE^PSOERUT0(MODE,$EXTRACT($GET(CLNC),32,62),$EXTRACT($GET(CLNC),32,62),9)
+117 SET XV="|"
DO ADDLINE^PSOERUT0(MODE,NMSPC,XE,XV)
End DoDot:1
+118 ;
+119 IF $GET(PENFLG)!$GET(SDFLG)
QUIT
+120 ;
+121 IF $GET(EXPLIC)'=""!($GET(VAPLIC)'="")
Begin DoDot:1
+122 SET XE="State Lic: "_$$COMPARE^PSOERUT0(MODE,EXPLIC,VAPLIC,12,,,'VAPRVIEN)
+123 SET XV="|State Lic: "_$$COMPARE^PSOERUT0(MODE,VAPLIC,EXPLIC,52)
+124 DO ADDLINE^PSOERUT0(MODE,NMSPC,XE,XV)
End DoDot:1
+125 ; Address
+126 DO BLANKLN^PSOERUT0(MODE)
+127 SET XE="Address:"
SET XV="|Address:"
DO ADDLINE^PSOERUT0(MODE,NMSPC,XE,XV)
+128 SET XE=" "_$$COMPARE^PSOERUT0(MODE,EXPADD1,VAPADD1,2,,,'VAPRVIEN)
+129 SET XV="| "_$$COMPARE^PSOERUT0(MODE,VAPADD1,EXPADD1,42)
DO ADDLINE^PSOERUT0(MODE,NMSPC,XE,XV)
+130 IF EXPADD2'=""!(VAPADD2'="")
Begin DoDot:1
+131 SET XE=" "_$$COMPARE^PSOERUT0(MODE,EXPADD2,VAPADD2,2,,,'VAPRVIEN)
+132 SET XV="| "_$$COMPARE^PSOERUT0(MODE,VAPADD2,EXPADD2,42)
DO ADDLINE^PSOERUT0(MODE,NMSPC,XE,XV)
End DoDot:1
+133 SET XE=" "_$$COMPARE^PSOERUT0(MODE,EXPCTY,VAPCIT,2,,,'VAPRVIEN)
+134 SET XE=XE_$SELECT(EXPCTY'="":",",1:"")_$$COMPARE^PSOERUT0(MODE,EXPST,VAPST,$LENGTH(XE)+2,,,'VAPRVIEN)
+135 SET XE=XE_" "_$$COMPARE^PSOERUT0(MODE,EXPZIP,VAPZIP,$LENGTH(XE)+3,1,,'VAPRVIEN)
+136 SET XV="| "_$$COMPARE^PSOERUT0(MODE,VAPCIT,EXPCTY,42)
+137 SET XV=XV_$SELECT(VAPCIT'="":",",1:"")_$$COMPARE^PSOERUT0(MODE,VAPST,EXPST,$LENGTH(XV)+41)
+138 SET XV=XV_" "_$$COMPARE^PSOERUT0(MODE,VAPZIP,EXPZIP,$LENGTH(XV)+42,1)
+139 DO ADDLINE^PSOERUT0(MODE,NMSPC,XE,XV)
+140 ; Communication #'s
+141 SET XE="Tel: "_$$COMPARE^PSOERUT0(MODE,$GET(PRTEL),$GET(VAPTEL),6,,,'VAPRVIEN)
+142 SET XV="|Tel: "_$$COMPARE^PSOERUT0(MODE,$GET(VAPTEL),$GET(PRTEL),46)
+143 DO ADDLINE^PSOERUT0(MODE,NMSPC,XE,XV)
+144 IF $GET(PRFAX)'=""!($GET(VAPFAX)'="")
Begin DoDot:1
+145 SET XE="Fax: "_$$COMPARE^PSOERUT0(MODE,$GET(PRFAX),$GET(VAPFAX),6,,,'VAPRVIEN)
+146 SET XV="|Fax: "_$$COMPARE^PSOERUT0(MODE,$GET(VAPFAX),$GET(PRFAX),46)
+147 DO ADDLINE^PSOERUT0(MODE,NMSPC,XE,XV)
End DoDot:1
+148 ;
+149 IF $GET(EXPAGNT)'=""!($GET(EXPSUPER)'="")
Begin DoDot:1
+150 DO BLANKLN^PSOERUT0(MODE)
End DoDot:1
+151 ;
+152 IF $GET(EXPAGNT)'=""
Begin DoDot:1
+153 DO TXT2ARY^PSOERXD1(.AGENTARY,EXPAGNT,,65)
+154 SET NLOOP=0
FOR
SET NLOOP=$ORDER(AGENTARY(NLOOP))
if 'NLOOP
QUIT
Begin DoDot:2
+155 SET AGENT=$EXTRACT($GET(AGENTARY(NLOOP)),1,32)
+156 SET XE="Agent: "_$$COMPARE^PSOERUT0(MODE,AGENT,AGENT,8,,,'VAPRVIEN)
+157 SET XV="| "
DO ADDLINE^PSOERUT0(MODE,NMSPC,XE,XV)
End DoDot:2
End DoDot:1
+158 IF $GET(EXPSUPER)'=""
Begin DoDot:1
+159 DO TXT2ARY^PSOERXD1(.SUPERARY,EXPSUPER,,65)
+160 SET TLOOP=0
FOR
SET TLOOP=$ORDER(SUPERARY(TLOOP))
if 'TLOOP
QUIT
Begin DoDot:2
+161 SET SUPERVSR=$EXTRACT($GET(SUPERARY(TLOOP)),1,27)
+162 SET XE="Supervisor: "_$$COMPARE^PSOERUT0(MODE,SUPERVSR,SUPERVSR,13,,,'VAPRVIEN)
+163 SET XV="| "
DO ADDLINE^PSOERUT0(MODE,NMSPC,XE,XV)
End DoDot:2
End DoDot:1
+164 DO BLANKLN^PSOERUT0(MODE)
+165 QUIT
