Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: PSOERUT1

PSOERUT1.m

Go to the documentation of this file.
  1. PSOERUT1 ;ALB/MFR - eRx Provider - ListMan Utilities; 06/25/2023 5:14pm
  1. ;;7.0;OUTPATIENT PHARMACY;**700,743,746**;DEC 1997;Build 106
  1. ;
  1. 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
  1. ; ERXIEN - Pointer to ERX HOLDING QUEUE file (#52.49)
  1. ; VAPRVIEN - Matched/Suggested VistA Patient - Pointer to PATIENT file (#2)
  1. ; (o)NMSPC - ListMan Temp Global Namespace (e.g., "PSOERXP1") - Required for LM Mode only
  1. ; (o)PENFLG - Pending Order Flag - 1: Pending Order Interface | 0: eRx Holding Queue Interface
  1. ; (o)SDFLG - Single eRx View/Display Flag - 1: Single eRx View/Display Interface | 0: eRx Holding Queue Interface
  1. ; Input Global Variable: LINE - Current ListMan Line # (Default)
  1. ; Output Global Variable: (ListMan Mode ONly)
  1. ; REVLN - Array Indicating Reverse Video for Line, position and size of the string
  1. ; HIGLN - Array Indicating Highlight for Line, position and size of the string
  1. ;
  1. S:'$G(LINE) LINE=1 S NMSPC=$G(NMSPC)
  1. N PARVDAT,EXPIEN,EXPIENS,EXPNM,EXPDOB,EXPSSN,EXPADD,EXPGEN,EXPCTY,EXPST,EXPZIP,HFIEN,EXPHPH,CPIEN,EXPCPH,LINETXT
  1. N EXPADD1,EXPADD2,EXPAGNT,EXPDEA,EXPFN,EXPLIC,EXPNPI,EXPSUPER,EXPWPH,FNIEN,MANVAL,PRVDAT,VAPADD1,VAPADD2,VAPCIT,DEAEXP
  1. N VAPDEA,VAPFAX,VAPIENS,VAPLIC,VAPNM,VAPNPI,VAPROV,VAPST,VAPTEL,VAPZIP,WPIEN,SEPLN,VAPDEAEX,VALBY,VALDTTM,AGENT,SUPERVSR
  1. N NLOOP,AGENTARY,TLOOP,TFIRST,SUPERARY,SIEN,TYPE,VALUE,PRFAX,PRTEL,IENS,S2017,DFN,X,XE,XV,SPECLTY,CLNC,VPROIEN
  1. ;
  1. ;eRx Provider Data
  1. S LINETXT=""
  1. S S2017=$$GET1^DIQ(52.49,ERXIEN,312.1)
  1. S EXPIEN=$$GET1^DIQ(52.49,ERXIEN,2.1,"I")
  1. I 'EXPIEN S EXPIEN=$$GETPROV^PSOERXU5(ERXIEN)
  1. S EXPIENS=EXPIEN_","
  1. D GETS^DIQ(52.48,EXPIENS,"**","E","PRVDAT")
  1. S EXPNM=$G(PRVDAT(52.48,EXPIENS,.01,"E"))
  1. S EXPNPI=$G(PRVDAT(52.48,EXPIENS,1.5,"E"))
  1. S EXPDEA=$G(PRVDAT(52.48,EXPIENS,1.6,"E"))
  1. S EXPLIC=$G(PRVDAT(52.48,EXPIENS,1.8,"E"))
  1. S SPECLTY=$G(PRVDAT(52.48,EXPIENS,1.2,"E"))
  1. S EXPAGNT=$G(PRVDAT(52.48,EXPIENS,5.1,"E"))
  1. I $L(EXPAGNT) D
  1. . S EXPAGNT=EXPAGNT_", "_$G(PRVDAT(52.48,EXPIENS,5.2,"E"))_" "_$G(PRVDAT(52.48,EXPIENS,5.3,"E"))
  1. S CLNC=$G(PRVDAT(52.48,EXPIENS,2.1,"E"))
  1. I CLNC="" S CLNC=$G(PRVDAT(52.48,EXPIENS,18.6,"E"))
  1. S EXPSUPER=$$GET1^DIQ(52.49,ERXIEN,2.6,"E")
  1. S EXPADD1=$G(PRVDAT(52.48,EXPIENS,4.1,"E"))
  1. S EXPADD2=$G(PRVDAT(52.48,EXPIENS,4.2,"E"))
  1. S EXPCTY=$G(PRVDAT(52.48,EXPIENS,4.3,"E"))
  1. S EXPST=$$GET1^DIQ(5,$$GET1^DIQ(52.48,EXPIENS,4.4,"I"),1)
  1. S EXPZIP=$G(PRVDAT(52.48,EXPIENS,4.5,"E")),EXPZIP=$E(EXPZIP,1,5)
  1. S WPIEN=$O(^PS(52.48,EXPIEN,3,"C","WP",0))
  1. S SIEN=0
  1. F S SIEN=$O(^PS(52.48,EXPIEN,3,SIEN)) Q:'SIEN D
  1. . S IENS=SIEN_","_EXPIEN_","
  1. . S TYPE=$$GET1^DIQ(52.483,IENS,.02)
  1. . S VALUE=$$GET1^DIQ(52.483,IENS,.01)
  1. . I TYPE="FAX" S PRFAX=VALUE
  1. . I TYPE="TELEPHONE" S PRTEL=VALUE
  1. I S2017 D
  1. . S EXPNPI=$$GET1^DIQ(52.48,EXPIEN,15.1)
  1. . S EXPDEA=$$GET1^DIQ(52.48,EXPIEN,14.5)
  1. . S EXPLIC=$$GET1^DIQ(52.48,EXPIEN,14.1)
  1. . S PRTEL=$$COMMVAL^PSOERXU5(EXPIEN,52.48,11,"PT",1)
  1. . S PRFAX=$$COMMVAL^PSOERXU5(EXPIEN,52.48,11,"F",1)
  1. ;
  1. ;VistA Provider Data
  1. I '$G(VAPRVIEN) S VAPRVIEN=+$$GET1^DIQ(52.49,ERXIEN,2.3,"I")
  1. S (VAPNM,VAPADD1,VAPADD2,VAPCIT,VAPST,VAPZIP,VAPNPI,VAPDEA,VAPLIC,VAPTEL,VAPFAX)=""
  1. S MANVAL=$$GET1^DIQ(52.49,ERXIEN,1.3,"I")
  1. S VALBY=$$GET1^DIQ(52.49,ERXIEN,1.8,"E")
  1. S VALDTTM=$$GET1^DIQ(52.49,ERXIEN,1.9,"E")
  1. I VAPRVIEN D
  1. . S VAPIENS=VAPRVIEN_","
  1. . D GETS^DIQ(200,VAPIENS,".01;.111;.112;.113;.114;.115;.116;.132;.136;41.99;53.2;54.2","IE","VAPROV")
  1. . S VAPNM=$G(VAPROV(200,VAPIENS,.01,"E"))
  1. . S VAPADD1=$G(VAPROV(200,VAPIENS,.111,"E"))
  1. . S VAPADD2=$G(VAPROV(200,VAPIENS,.112,"E"))
  1. . S VAPCIT=$G(VAPROV(200,VAPIENS,.114,"E"))
  1. . S VAPST=$$GET1^DIQ(5,$$GET1^DIQ(200,VAPRVIEN,.115,"I"),1)
  1. . S VAPZIP=$G(VAPROV(200,VAPIENS,.116,"E"))
  1. . S VAPNPI=$G(VAPROV(200,VAPIENS,41.99,"E"))
  1. . S VAPDEA=$P($$VADEA^PSOERXU8(VAPRVIEN,ERXIEN),"^",2)
  1. . S VAPDEAEX=$$DEAXDT^XUSER(VAPDEA) I VAPDEAEX,VAPDEAEX<DT S DEAEXP=1
  1. . S VAPLIC=$G(VAPROV(200,VAPIENS,54.2,"E"))
  1. . S VAPTEL=$G(VAPROV(200,VAPIENS,.132,"E"))
  1. . S VAPFAX=$G(VAPROV(200,VAPIENS,.136,"E"))
  1. . S MANVAL=$$GET1^DIQ(52.49,ERXIEN,1.3,"I")
  1. ;
  1. ; - Provider Matching Header Line
  1. I $G(PENFLG)!($G(SDFLG)) D
  1. . N AMATCH,VPATIEN,VALUSER,VALDTTM,MATCH,HDR
  1. . S AMATCH=$$GET1^DIQ(52.49,ERXIEN,1.2,"I"),VPROIEN=$$GET1^DIQ(52.49,ERXIEN,2.3,"I")
  1. . S VALUSER=$$GET1^DIQ(52.49,ERXIEN,1.8,"E"),VALDTTM=$$GET1^DIQ(52.49,ERXIEN,1.9,"I")
  1. . I $$GET1^DIQ(52.49,ERXIEN,.08,"I")="RE",'VALDTTM D
  1. . . S MATCH="PREVIOUSLY MATCHED/VALIDATED (RENEWAL)"
  1. . E D
  1. . . S MATCH=$S(AMATCH=1:"AUTO-MATCHED",AMATCH=2:"AUTO-MATCHED/EDITED",VPROIEN:"MANUALLY-MATCHED",1:"")
  1. . . I VALUSER'="",MATCH'="" S MATCH=MATCH_" | VALIDATED by "_$E(VALUSER,1,19)_" on "_$$FMTE^XLFDT(VALDTTM,"2Y")
  1. . . I MATCH="" S MATCH="NOT MATCHED"
  1. . S MATCH="PROVIDER "_MATCH I $L(MATCH)>78 S MATCH=$E(MATCH,1,78)
  1. . S HDR="",$E(HDR,(80-$L(MATCH))\2+1)=MATCH,$E(HDR,81)=""
  1. . S $E(MATCH,81)=""
  1. . S UNDERLN(LINE,1)=100 I HDR["/EDITED" S BLINKLN(LINE,$F(HDR,"/EDITED")-6)=6
  1. . D ADDLINE^PSOERUT0(MODE,NMSPC,HDR,"")
  1. ;
  1. ;Side-by-side Display
  1. S XE="Name: "_$$COMPARE^PSOERUT0(MODE,$E(EXPNM,1,33),VAPNM,7,,,'VAPRVIEN)
  1. S XV="|Name: "_$$COMPARE^PSOERUT0(MODE,VAPNM,EXPNM,47)
  1. D ADDLINE^PSOERUT0(MODE,NMSPC,XE,XV)
  1. I $L(EXPNM)>33 D
  1. . S XE=" "_$$COMPARE^PSOERUT0(MODE,$E(EXPNM,34,67),"",7,,,'VAPRVIEN),XV="|"
  1. . D ADDLINE^PSOERUT0(MODE,NMSPC,XE,XV)
  1. S XE="NPI : "_$$COMPARE^PSOERUT0(MODE,EXPNPI,VAPNPI,7,,,'VAPRVIEN)
  1. S XV="|NPI : "_$$COMPARE^PSOERUT0(MODE,VAPNPI,EXPNPI,47)
  1. D ADDLINE^PSOERUT0(MODE,NMSPC,XE,XV)
  1. S XE="DEA : "_$$COMPARE^PSOERUT0(MODE,EXPDEA,VAPDEA,7,,,'VAPRVIEN)
  1. S XV="|DEA : "_$$COMPARE^PSOERUT0(MODE,VAPDEA,EXPDEA,47)
  1. I $G(VAPDEAEX)'="" D
  1. . S $E(XV,20)="DEA EXP: "_$$COMPARE^PSOERUT0(MODE,$$FMTE^XLFDT(VAPDEAEX,"2Y"),$S($G(DEAEXP):"",1:$$FMTE^XLFDT(VAPDEAEX,"2Y")),68)
  1. D ADDLINE^PSOERUT0(MODE,NMSPC,XE,XV)
  1. ;
  1. ; Clinic (Wraps only in the Validate Provider Screen)
  1. S XE="Clinic: "_$$COMPARE^PSOERUT0(MODE,$E($G(CLNC),1,31),$E($G(CLNC),1,31),9)
  1. S XV="|" D ADDLINE^PSOERUT0(MODE,NMSPC,XE,XV)
  1. I '$G(SDFLG),$L(CLNC)>31 D
  1. . S XE="",$E(XE,9)=$$COMPARE^PSOERUT0(MODE,$E($G(CLNC),32,62),$E($G(CLNC),32,62),9)
  1. . S XV="|" D ADDLINE^PSOERUT0(MODE,NMSPC,XE,XV)
  1. ;
  1. I $G(PENFLG)!$G(SDFLG) Q
  1. ;
  1. I $G(EXPLIC)'=""!($G(VAPLIC)'="") D
  1. . S XE="State Lic: "_$$COMPARE^PSOERUT0(MODE,EXPLIC,VAPLIC,12,,,'VAPRVIEN)
  1. . S XV="|State Lic: "_$$COMPARE^PSOERUT0(MODE,VAPLIC,EXPLIC,52)
  1. . D ADDLINE^PSOERUT0(MODE,NMSPC,XE,XV)
  1. ; Address
  1. D BLANKLN^PSOERUT0(MODE)
  1. S XE="Address:",XV="|Address:" D ADDLINE^PSOERUT0(MODE,NMSPC,XE,XV)
  1. S XE=" "_$$COMPARE^PSOERUT0(MODE,EXPADD1,VAPADD1,2,,,'VAPRVIEN)
  1. S XV="| "_$$COMPARE^PSOERUT0(MODE,VAPADD1,EXPADD1,42) D ADDLINE^PSOERUT0(MODE,NMSPC,XE,XV)
  1. I EXPADD2'=""!(VAPADD2'="") D
  1. . S XE=" "_$$COMPARE^PSOERUT0(MODE,EXPADD2,VAPADD2,2,,,'VAPRVIEN)
  1. . S XV="| "_$$COMPARE^PSOERUT0(MODE,VAPADD2,EXPADD2,42) D ADDLINE^PSOERUT0(MODE,NMSPC,XE,XV)
  1. S XE=" "_$$COMPARE^PSOERUT0(MODE,EXPCTY,VAPCIT,2,,,'VAPRVIEN)
  1. S XE=XE_$S(EXPCTY'="":",",1:"")_$$COMPARE^PSOERUT0(MODE,EXPST,VAPST,$L(XE)+2,,,'VAPRVIEN)
  1. S XE=XE_" "_$$COMPARE^PSOERUT0(MODE,EXPZIP,VAPZIP,$L(XE)+3,1,,'VAPRVIEN)
  1. S XV="| "_$$COMPARE^PSOERUT0(MODE,VAPCIT,EXPCTY,42)
  1. S XV=XV_$S(VAPCIT'="":",",1:"")_$$COMPARE^PSOERUT0(MODE,VAPST,EXPST,$L(XV)+41)
  1. S XV=XV_" "_$$COMPARE^PSOERUT0(MODE,VAPZIP,EXPZIP,$L(XV)+42,1)
  1. D ADDLINE^PSOERUT0(MODE,NMSPC,XE,XV)
  1. ; Communication #'s
  1. S XE="Tel: "_$$COMPARE^PSOERUT0(MODE,$G(PRTEL),$G(VAPTEL),6,,,'VAPRVIEN)
  1. S XV="|Tel: "_$$COMPARE^PSOERUT0(MODE,$G(VAPTEL),$G(PRTEL),46)
  1. D ADDLINE^PSOERUT0(MODE,NMSPC,XE,XV)
  1. I $G(PRFAX)'=""!($G(VAPFAX)'="") D
  1. . S XE="Fax: "_$$COMPARE^PSOERUT0(MODE,$G(PRFAX),$G(VAPFAX),6,,,'VAPRVIEN)
  1. . S XV="|Fax: "_$$COMPARE^PSOERUT0(MODE,$G(VAPFAX),$G(PRFAX),46)
  1. . D ADDLINE^PSOERUT0(MODE,NMSPC,XE,XV)
  1. ;
  1. I $G(EXPAGNT)'=""!($G(EXPSUPER)'="") D
  1. . D BLANKLN^PSOERUT0(MODE)
  1. ;
  1. I $G(EXPAGNT)'="" D
  1. . D TXT2ARY^PSOERXD1(.AGENTARY,EXPAGNT,,65)
  1. . S NLOOP=0 F S NLOOP=$O(AGENTARY(NLOOP)) Q:'NLOOP D
  1. . . S AGENT=$E($G(AGENTARY(NLOOP)),1,32)
  1. . . S XE="Agent: "_$$COMPARE^PSOERUT0(MODE,AGENT,AGENT,8,,,'VAPRVIEN)
  1. . . S XV="| " D ADDLINE^PSOERUT0(MODE,NMSPC,XE,XV)
  1. I $G(EXPSUPER)'="" D
  1. . D TXT2ARY^PSOERXD1(.SUPERARY,EXPSUPER,,65)
  1. . S TLOOP=0 F S TLOOP=$O(SUPERARY(TLOOP)) Q:'TLOOP D
  1. . . S SUPERVSR=$E($G(SUPERARY(TLOOP)),1,27)
  1. . . S XE="Supervisor: "_$$COMPARE^PSOERUT0(MODE,SUPERVSR,SUPERVSR,13,,,'VAPRVIEN)
  1. . . S XV="| " D ADDLINE^PSOERUT0(MODE,NMSPC,XE,XV)
  1. D BLANKLN^PSOERUT0(MODE)
  1. Q