PSOERUT1 ;ALB/MFR - eRx Provider - ListMan Utilities; 06/25/2023 5:14pm
;;7.0;OUTPATIENT PHARMACY;**700,743,746,770**;DEC 1997;Build 145
;
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 Provider - Pointer to PATIENT file (#200)
; (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*10000\1/10000,"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 : "_$J($$COMPARE^PSOERUT0(MODE,VAPNPI,EXPNPI,47),10)
D ADDLINE^PSOERUT0(MODE,NMSPC,XE,XV)
I $G(SDFLG)!$G(PENFLG) S LINE=LINE-1 D PROVCOMM
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)
;
; 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="|Class: "_$$COMPARE^PSOERUT0(MODE,$$GET1^DIQ(200,VAPRVIEN,53.5),$$GET1^DIQ(200,VAPRVIEN,53.5),48) 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,"ADD",,'VAPRVIEN)
S XV="| "_$$COMPARE^PSOERUT0(MODE,VAPADD1,EXPADD1,42,"ADD") D ADDLINE^PSOERUT0(MODE,NMSPC,XE,XV)
I EXPADD2'=""!(VAPADD2'="") D
. S XE=" "_$$COMPARE^PSOERUT0(MODE,EXPADD2,VAPADD2,2,"ADD",,'VAPRVIEN)
. S XV="| "_$$COMPARE^PSOERUT0(MODE,VAPADD2,EXPADD2,42,"ADD") 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,"ZIP",,'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,"ZIP")
D ADDLINE^PSOERUT0(MODE,NMSPC,XE,XV)
D PROVCOMM
Q
;
PROVCOMM ; Communication #'s
S XE=$S($G(SDFLG)!$G(PENFLG):XE_" Phone: ",1:"Tel: ")_$$COMPARE^PSOERUT0(MODE,$G(PRTEL),$G(VAPTEL),$S($G(SDFLG)!$G(PENFLG):26,1:6),,,'VAPRVIEN)
S XV=$S($G(SDFLG)!$G(PENFLG):XV_" Phone: ",1:"|Tel: ")_$$COMPARE^PSOERUT0(MODE,$G(VAPTEL),$G(PRTEL),$S($G(SDFLG)!$G(PENFLG):66,1:46))
D ADDLINE^PSOERUT0(MODE,NMSPC,XE,XV)
I $G(SDFLG)!$G(PENFLG) Q
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
;
USPSABBS ; USPS Abbreviations
;; DRIVE ^ DR ; ROAD ^ RD ; AVENUE ^ AVE ; STREET ^ ST ; LANE ^ LN ; HIGHWAY ^ HGWY ; BOULEVARD ^ BLVD ; COURT ^ CT ; APARTMENT ^ APT ;
;; WEST ^ W ; EAST ^ E ; SOUTH ^ S ; NORTH ^ N ; NORTHEAST ^ NE ; NORTWEST ^ NW ; SOUTHWEST ^ SW ; SOUTHEAST ^ SE ; ALLEY ^ ALY ;
;; BEND ^ BND ; BLUFF ^ BLF ; BOTTOM ^ BTM ; BRANCH ^ BR ; BRIDGE ^ BRG ; BROOK ^ BRK ; BYPASS ^ BYP ; CAMP ^ CP ; CANYON ^ CYN ;
;; CIRCLE ^ CIR ; CLIFF ^ CLF ; CLUB ^ CLB ; COMMON ^ CMN ; CORNER ^ COR ; COURSE ^ CRSE ; TERRACE ^ TER ; BAYOU ^ BYU ; BEACH ^ BCH ;
;; COURT ^ CT ; COVE ^ CV ; COVES ^ CVS ; CREEK ^ CRK ; CRESCENT ^ CRES ; CREST ^ CRST ; CROSSING ^ XING ; CROSSROAD ^ XRD ; CURVE ^ CURV ;
;; DALE ^ DL ; DAM ^ DM ; DIVIDE ^ DV ; ESTATE ^ EST ; EXPRESSWAY ^ EXPY ; EXTENSION ^ EXT ; FERRY ^ FRY ; FIELD ^ FLD ; FLAT ^ FLT ;
;; FORD ^ FRD ; FOREST ^ FRST ; FORGE ^ FRG ; FORK ^ FRK ; FORT ^ FT ; FREEWAY ^ FWY ; GARDEN ^ GDN ; GATEWAY ^ GTWY ; GLEN ^ GLN ;
;; GREEN ^ GRN ; GROVE ^ GRV ; HARBOR ^ HBR ; HAVEN ^ HVN ; HEIGHTS ^ HTS ; HILL ^ HL ; HILLS ^ HLS ; SUITE ^ STE ; ROOM ^ RM ;
;; HOLLOW ^ HOLW ; INLET ^ INLT ; JUNCTION ^ JCT ; JUNCTIONS ^ JCTS ; KEY ^ KY ; KEYS ^ KYS ; KNOLL ^ KNL ; KNOLLS ^ KNLS ; LAKE ^ LK ;
;; LAKES ^ LKS ; LANDING ^ LNDG ; LIGHT ^ LGT ; LIGHTS ^ LGTS ; LOAF ^ LF ; LOCK ^ LCK ; LOCKS ^ LCKS ; LODGE ^ LDG ; MANOR ^ MNR ;
;; MILL ^ ML ; MILLS ^ MLS ; MISSION ^ MSN ; MOTORWAY ^ MTWY ; MOUNT ^ MT ; MOUNTAIN ^ MTN ; NECK ^ NCK ; ORCHARD ^ ORCH ; OVERPASS ^ OPAS ;
;; PARKWAY ^ PKWY ; PASSAGE ^ PSGE ; PINE ^ PNE ; PINES ^ PNES ; PLACE ^ PL ; PLAIN ^ PLN ; PLAINS ^ PLNS ; PLAZA ^ PLZ ; POINT ^ PT ;
;; PRARIE ^ PR ; RADIAL ^ RADL ; RANCH ^ RNCH ; RAPID ^ RPD ; RAPIDS ^ RPDS ; REST ^ RST ; RIDGE ^ RDG ; RIVER ^ RIV ; ROUTE ^ RTE ;
;; SHOAL ^ SHL ; SHOALS ^ SHLS ; SHORE ^ SHR ; SHORES ^ SHRS ; SKYWAY ^ SKWY ; SPRING ^ SPG ; SPRINGS ^ SPGS ; SQUARE ^ SQ ;
;; STREAM ^ STRM ; SUMMIT ^ SMT ; THROUGHWAY ^ TRWY ; TRACE ^ TRCE ; TRACK ^ TRAK ; TRAFFICWAY ^ TRFY ; TRAIL ^ TRL ; TUNNEL ^ TUNL ;
;; UNDERPASS ^ UPAS ; UNION ^ UN ; VALLEY ^ VLY ; VALLEYS ^ VLYS ; VIADUCT ^ VIA ; VIEW ^ VW ; VILLAGE ^ VLG ; CAPE ^ CP ; CAUSEWAY ^ CSWY ;
;; BUILDING ^ BLDG ; VILLE ^ VL ; VISTA ^ VIS ; WELL ^ WL ; WELLS ^ WLS ; CENTER ^ CTR ; FALLS ^ FLS ; FERRY ^ FRY ; FIELD ^ FLD ;
;; ANNEX ^ ANX ; MEADOW ^ MDW ; PORT ^ PRT ; SQUARES ^ SQS ; STATION ^ STA ; TURNPIKE ^ TPKE ;
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSOERUT1 11580 printed Aug 26, 2025@22:44:07 Page 2
PSOERUT1 ;ALB/MFR - eRx Provider - ListMan Utilities; 06/25/2023 5:14pm
+1 ;;7.0;OUTPATIENT PHARMACY;**700,743,746,770**;DEC 1997;Build 145
+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 Provider - Pointer to PATIENT file (#200)
+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*10000\1/10000,"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 : "_$JUSTIFY($$COMPARE^PSOERUT0(MODE,VAPNPI,EXPNPI,47),10)
+105 DO ADDLINE^PSOERUT0(MODE,NMSPC,XE,XV)
+106 IF $GET(SDFLG)!$GET(PENFLG)
SET LINE=LINE-1
DO PROVCOMM
+107 SET XE="DEA : "_$$COMPARE^PSOERUT0(MODE,EXPDEA,VAPDEA,7,,,'VAPRVIEN)
+108 SET XV="|DEA : "_$$COMPARE^PSOERUT0(MODE,VAPDEA,EXPDEA,47)
+109 IF $GET(VAPDEAEX)'=""
Begin DoDot:1
+110 SET XV=XV_" DEA EXP: "_$$COMPARE^PSOERUT0(MODE,$$FMTE^XLFDT(VAPDEAEX,"2Y"),$SELECT($GET(DEAEXP):"",1:$$FMTE^XLFDT(VAPDEAEX,"2Y")),68)
End DoDot:1
+111 DO ADDLINE^PSOERUT0(MODE,NMSPC,XE,XV)
+112 ;
+113 ; Clinic (Wraps only in the Validate Provider Screen)
+114 SET XE="Clinic: "_$$COMPARE^PSOERUT0(MODE,$EXTRACT($GET(CLNC),1,31),$EXTRACT($GET(CLNC),1,31),9)
+115 SET XV="|Class: "_$$COMPARE^PSOERUT0(MODE,$$GET1^DIQ(200,VAPRVIEN,53.5),$$GET1^DIQ(200,VAPRVIEN,53.5),48)
DO ADDLINE^PSOERUT0(MODE,NMSPC,XE,XV)
+116 IF '$GET(SDFLG)
IF $LENGTH(CLNC)>31
Begin DoDot:1
+117 SET XE=""
SET $EXTRACT(XE,9)=$$COMPARE^PSOERUT0(MODE,$EXTRACT($GET(CLNC),32,62),$EXTRACT($GET(CLNC),32,62),9)
+118 SET XV="|"
DO ADDLINE^PSOERUT0(MODE,NMSPC,XE,XV)
End DoDot:1
+119 ;
+120 IF $GET(PENFLG)!$GET(SDFLG)
QUIT
+121 ;
+122 IF $GET(EXPLIC)'=""!($GET(VAPLIC)'="")
Begin DoDot:1
+123 SET XE="State Lic: "_$$COMPARE^PSOERUT0(MODE,EXPLIC,VAPLIC,12,,,'VAPRVIEN)
+124 SET XV="|State Lic: "_$$COMPARE^PSOERUT0(MODE,VAPLIC,EXPLIC,52)
+125 DO ADDLINE^PSOERUT0(MODE,NMSPC,XE,XV)
End DoDot:1
+126 ; Address
+127 DO BLANKLN^PSOERUT0(MODE)
+128 SET XE="Address:"
SET XV="|Address:"
DO ADDLINE^PSOERUT0(MODE,NMSPC,XE,XV)
+129 SET XE=" "_$$COMPARE^PSOERUT0(MODE,EXPADD1,VAPADD1,2,"ADD",,'VAPRVIEN)
+130 SET XV="| "_$$COMPARE^PSOERUT0(MODE,VAPADD1,EXPADD1,42,"ADD")
DO ADDLINE^PSOERUT0(MODE,NMSPC,XE,XV)
+131 IF EXPADD2'=""!(VAPADD2'="")
Begin DoDot:1
+132 SET XE=" "_$$COMPARE^PSOERUT0(MODE,EXPADD2,VAPADD2,2,"ADD",,'VAPRVIEN)
+133 SET XV="| "_$$COMPARE^PSOERUT0(MODE,VAPADD2,EXPADD2,42,"ADD")
DO ADDLINE^PSOERUT0(MODE,NMSPC,XE,XV)
End DoDot:1
+134 SET XE=" "_$$COMPARE^PSOERUT0(MODE,EXPCTY,VAPCIT,2,,,'VAPRVIEN)
+135 SET XE=XE_$SELECT(EXPCTY'="":",",1:"")_$$COMPARE^PSOERUT0(MODE,EXPST,VAPST,$LENGTH(XE)+2,,,'VAPRVIEN)
+136 SET XE=XE_" "_$$COMPARE^PSOERUT0(MODE,EXPZIP,VAPZIP,$LENGTH(XE)+3,"ZIP",,'VAPRVIEN)
+137 SET XV="| "_$$COMPARE^PSOERUT0(MODE,VAPCIT,EXPCTY,42)
+138 SET XV=XV_$SELECT(VAPCIT'="":",",1:"")_$$COMPARE^PSOERUT0(MODE,VAPST,EXPST,$LENGTH(XV)+41)
+139 SET XV=XV_" "_$$COMPARE^PSOERUT0(MODE,VAPZIP,EXPZIP,$LENGTH(XV)+42,"ZIP")
+140 DO ADDLINE^PSOERUT0(MODE,NMSPC,XE,XV)
+141 DO PROVCOMM
+142 QUIT
+143 ;
PROVCOMM ; Communication #'s
+1 SET XE=$SELECT($GET(SDFLG)!$GET(PENFLG):XE_" Phone: ",1:"Tel: ")_$$COMPARE^PSOERUT0(MODE,$GET(PRTEL),$GET(VAPTEL),$SELECT($GET(SDFLG)!$GET(PENFLG):26,1:6),,,'VAPRVIEN)
+2 SET XV=$SELECT($GET(SDFLG)!$GET(PENFLG):XV_" Phone: ",1:"|Tel: ")_$$COMPARE^PSOERUT0(MODE,$GET(VAPTEL),$GET(PRTEL),$SELECT($GET(SDFLG)!$GET(PENFLG):66,1:46))
+3 DO ADDLINE^PSOERUT0(MODE,NMSPC,XE,XV)
+4 IF $GET(SDFLG)!$GET(PENFLG)
QUIT
+5 IF $GET(PRFAX)'=""!($GET(VAPFAX)'="")
Begin DoDot:1
+6 SET XE="Fax: "_$$COMPARE^PSOERUT0(MODE,$GET(PRFAX),$GET(VAPFAX),6,,,'VAPRVIEN)
+7 SET XV="|Fax: "_$$COMPARE^PSOERUT0(MODE,$GET(VAPFAX),$GET(PRFAX),46)
+8 DO ADDLINE^PSOERUT0(MODE,NMSPC,XE,XV)
End DoDot:1
+9 ;
+10 IF $GET(EXPAGNT)'=""!($GET(EXPSUPER)'="")
Begin DoDot:1
+11 DO BLANKLN^PSOERUT0(MODE)
End DoDot:1
+12 ;
+13 IF $GET(EXPAGNT)'=""
Begin DoDot:1
+14 DO TXT2ARY^PSOERXD1(.AGENTARY,EXPAGNT,,65)
+15 SET NLOOP=0
FOR
SET NLOOP=$ORDER(AGENTARY(NLOOP))
if 'NLOOP
QUIT
Begin DoDot:2
+16 SET AGENT=$EXTRACT($GET(AGENTARY(NLOOP)),1,32)
+17 SET XE="Agent: "_$$COMPARE^PSOERUT0(MODE,AGENT,AGENT,8,,,'VAPRVIEN)
+18 SET XV="| "
DO ADDLINE^PSOERUT0(MODE,NMSPC,XE,XV)
End DoDot:2
End DoDot:1
+19 IF $GET(EXPSUPER)'=""
Begin DoDot:1
+20 DO TXT2ARY^PSOERXD1(.SUPERARY,EXPSUPER,,65)
+21 SET TLOOP=0
FOR
SET TLOOP=$ORDER(SUPERARY(TLOOP))
if 'TLOOP
QUIT
Begin DoDot:2
+22 SET SUPERVSR=$EXTRACT($GET(SUPERARY(TLOOP)),1,27)
+23 SET XE="Supervisor: "_$$COMPARE^PSOERUT0(MODE,SUPERVSR,SUPERVSR,13,,,'VAPRVIEN)
+24 SET XV="| "
DO ADDLINE^PSOERUT0(MODE,NMSPC,XE,XV)
End DoDot:2
End DoDot:1
+25 DO BLANKLN^PSOERUT0(MODE)
+26 QUIT
+27 ;
USPSABBS ; USPS Abbreviations
+1 ;; DRIVE ^ DR ; ROAD ^ RD ; AVENUE ^ AVE ; STREET ^ ST ; LANE ^ LN ; HIGHWAY ^ HGWY ; BOULEVARD ^ BLVD ; COURT ^ CT ; APARTMENT ^ APT ;
+2 ;; WEST ^ W ; EAST ^ E ; SOUTH ^ S ; NORTH ^ N ; NORTHEAST ^ NE ; NORTWEST ^ NW ; SOUTHWEST ^ SW ; SOUTHEAST ^ SE ; ALLEY ^ ALY ;
+3 ;; BEND ^ BND ; BLUFF ^ BLF ; BOTTOM ^ BTM ; BRANCH ^ BR ; BRIDGE ^ BRG ; BROOK ^ BRK ; BYPASS ^ BYP ; CAMP ^ CP ; CANYON ^ CYN ;
+4 ;; CIRCLE ^ CIR ; CLIFF ^ CLF ; CLUB ^ CLB ; COMMON ^ CMN ; CORNER ^ COR ; COURSE ^ CRSE ; TERRACE ^ TER ; BAYOU ^ BYU ; BEACH ^ BCH ;
+5 ;; COURT ^ CT ; COVE ^ CV ; COVES ^ CVS ; CREEK ^ CRK ; CRESCENT ^ CRES ; CREST ^ CRST ; CROSSING ^ XING ; CROSSROAD ^ XRD ; CURVE ^ CURV ;
+6 ;; DALE ^ DL ; DAM ^ DM ; DIVIDE ^ DV ; ESTATE ^ EST ; EXPRESSWAY ^ EXPY ; EXTENSION ^ EXT ; FERRY ^ FRY ; FIELD ^ FLD ; FLAT ^ FLT ;
+7 ;; FORD ^ FRD ; FOREST ^ FRST ; FORGE ^ FRG ; FORK ^ FRK ; FORT ^ FT ; FREEWAY ^ FWY ; GARDEN ^ GDN ; GATEWAY ^ GTWY ; GLEN ^ GLN ;
+8 ;; GREEN ^ GRN ; GROVE ^ GRV ; HARBOR ^ HBR ; HAVEN ^ HVN ; HEIGHTS ^ HTS ; HILL ^ HL ; HILLS ^ HLS ; SUITE ^ STE ; ROOM ^ RM ;
+9 ;; HOLLOW ^ HOLW ; INLET ^ INLT ; JUNCTION ^ JCT ; JUNCTIONS ^ JCTS ; KEY ^ KY ; KEYS ^ KYS ; KNOLL ^ KNL ; KNOLLS ^ KNLS ; LAKE ^ LK ;
+10 ;; LAKES ^ LKS ; LANDING ^ LNDG ; LIGHT ^ LGT ; LIGHTS ^ LGTS ; LOAF ^ LF ; LOCK ^ LCK ; LOCKS ^ LCKS ; LODGE ^ LDG ; MANOR ^ MNR ;
+11 ;; MILL ^ ML ; MILLS ^ MLS ; MISSION ^ MSN ; MOTORWAY ^ MTWY ; MOUNT ^ MT ; MOUNTAIN ^ MTN ; NECK ^ NCK ; ORCHARD ^ ORCH ; OVERPASS ^ OPAS ;
+12 ;; PARKWAY ^ PKWY ; PASSAGE ^ PSGE ; PINE ^ PNE ; PINES ^ PNES ; PLACE ^ PL ; PLAIN ^ PLN ; PLAINS ^ PLNS ; PLAZA ^ PLZ ; POINT ^ PT ;
+13 ;; PRARIE ^ PR ; RADIAL ^ RADL ; RANCH ^ RNCH ; RAPID ^ RPD ; RAPIDS ^ RPDS ; REST ^ RST ; RIDGE ^ RDG ; RIVER ^ RIV ; ROUTE ^ RTE ;
+14 ;; SHOAL ^ SHL ; SHOALS ^ SHLS ; SHORE ^ SHR ; SHORES ^ SHRS ; SKYWAY ^ SKWY ; SPRING ^ SPG ; SPRINGS ^ SPGS ; SQUARE ^ SQ ;
+15 ;; STREAM ^ STRM ; SUMMIT ^ SMT ; THROUGHWAY ^ TRWY ; TRACE ^ TRCE ; TRACK ^ TRAK ; TRAFFICWAY ^ TRFY ; TRAIL ^ TRL ; TUNNEL ^ TUNL ;
+16 ;; UNDERPASS ^ UPAS ; UNION ^ UN ; VALLEY ^ VLY ; VALLEYS ^ VLYS ; VIADUCT ^ VIA ; VIEW ^ VW ; VILLAGE ^ VLG ; CAPE ^ CP ; CAUSEWAY ^ CSWY ;
+17 ;; BUILDING ^ BLDG ; VILLE ^ VL ; VISTA ^ VIS ; WELL ^ WL ; WELLS ^ WLS ; CENTER ^ CTR ; FALLS ^ FLS ; FERRY ^ FRY ; FIELD ^ FLD ;
+18 ;; ANNEX ^ ANX ; MEADOW ^ MDW ; PORT ^ PRT ; SQUARES ^ SQS ; STATION ^ STA ; TURNPIKE ^ TPKE ;
+19 QUIT
