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