- 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 Jan 18, 2025@03:29:11 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