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

PSOERXR1.m

Go to the documentation of this file.
PSOERXR1 ;ALB/BWF - eRx Provider Display/actions ; 8/3/2016 5:14pm
 ;;7.0;OUTPATIENT PHARMACY;**467,520,527,581**;DEC 1997;Build 126
 ;
EN ; -- main entry point for PSO ERX HOLDING QUEUE
 D EN^VALM("PSO ERX PROVIDER VALIDATION")
 Q
 ;
HDR ; -- header code
 ;S VALMHDR(1)="eRx Processing"
 S VALMHDR(1)="eRx Patient: "_$$GET1^DIQ(52.49,PSOIEN,.04,"E")
 S VALMHDR(2)="eRx Reference #: "_$$GET1^DIQ(52.49,PSOIEN,.01,"E")
 S VALMHDR(3)=$$BHW^PSOERXIU(PSOIEN)
 I $G(VALMBCK)="R" D INIT
 Q
 ;
INIT ;
 Q:'$G(PSOIEN)
 N LINE,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,VAPRVIEN,VAPST,VAPTEL,VAPZIP,WPIEN,SEPLN,VAPDEAEX,VALBY,VALDTTM,NFIRST
 N NLOOP,AGENTARY,TLOOP,TFIRST,SUPERARY,SIEN,TYPE,VALUE,PRFAX,PRTEL,IENS,S2017
 S LINE=0,LINETXT=""
 S S2017=$$GET1^DIQ(52.49,PSOIEN,312.1)
 S EXPIEN=$$GET1^DIQ(52.49,PSOIEN,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) 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,PSOIEN,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=$G(PRVDAT(52.48,EXPIENS,4.4,"E"))
 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
 S LINE=LINE+1 D SET^VALM10(LINE,"eRx Provider: "_$E(EXPNM,1,50))
 S LINE=LINE+1 D SET^VALM10(LINE,"Address: "_$E(EXPADD1,1,50))
 S LINE=LINE+1 D SET^VALM10(LINE,"         "_$E(EXPADD2,1,50))
 S LINE=LINE+1 D SET^VALM10(LINE,"         "_EXPCTY_", "_EXPST_" "_EXPZIP)
 S LINE=LINE+1
 I S2017 D
 .S EXPNPI=$$GET1^DIQ(52.48,EXPIEN,15.1),EXPDEA=$$GET1^DIQ(52.48,EXPIEN,14.5),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)
 D ADDITEM^PSOERX1A(.LINETXT,"NPI: ",EXPNPI,1,40)
 D SET^VALM10(LINE,LINETXT) S LINETXT=""
 S LINE=LINE+1
 D ADDITEM^PSOERX1A(.LINETXT,"DEA: ",EXPDEA,1,40)
 D SET^VALM10(LINE,LINETXT) S LINETXT=""
 S LINE=LINE+1
 D ADDITEM^PSOERX1A(.LINETXT,"State Lic: ",EXPLIC,1,46)
 D SET^VALM10(LINE,LINETXT) S LINETXT=""
 S LINE=LINE+1
 D ADDITEM^PSOERX1A(.LINETXT,"Tel: ",$G(PRTEL),1,26)
 D ADDITEM^PSOERX1A(.LINETXT,"Fax: ",$G(PRFAX),28,26)
 D SET^VALM10(LINE,LINETXT) S LINETXT=""
 S LINE=LINE+1
 I $L($G(EXPAGNT)) D
 .D TXT2ARY^PSOERXD1(.AGENTARY,EXPAGNT,,65)
 .S NFIRST=$O(AGENTARY(0))
 .S NLOOP=0 F  S NLOOP=$O(AGENTARY(NLOOP)) Q:'NLOOP  D
 ..S LINE=LINE+1 D SET^VALM10(LINE,$S(NLOOP=NFIRST:"Agent: ",1:" ")_$G(AGENTARY(NLOOP)))
 .S LINE=LINE+1
 I $L($G(EXPSUPER)) D
 .D TXT2ARY^PSOERXD1(.SUPERARY,EXPSUPER,,65)
 .S TFIRST=$O(SUPERARY(0))
 .S TLOOP=0 F  S TLOOP=$O(SUPERARY(TLOOP)) Q:'TLOOP  D
 ..S LINE=LINE+1 D SET^VALM10(LINE,$S(TLOOP=TFIRST:"Supervisor: ",1:" ")_$G(SUPERARY(TLOOP)))
 .S LINE=LINE+1
 D SET^VALM10(LINE,LINETXT) S LINETXT=""
 S $P(SEPLN,"-",80)="-" D SET^VALM10(LINE,SEPLN)
 S VAPRVIEN=$$GET1^DIQ(52.49,PSOIEN,2.3,"I")
 S (VAPNM,VAPADD1,VAPADD2,VAPCIT,VAPST,VAPZIP,VAPNPI,VAPDEA,VAPLIC,VAPTEL,VAPFAX)=""
 S MANVAL=$$GET1^DIQ(52.49,PSOIEN,1.3,"I")
 S VALBY=$$GET1^DIQ(52.49,PSOIEN,1.8,"E")
 S VALDTTM=$$GET1^DIQ(52.49,PSOIEN,1.9,"E")
 S LINE=LINE+1 D SET^VALM10(LINE,"Status: "_$S(MANVAL:"VALIDATED ("_VALBY_" - "_VALDTTM_")",1:"NOT VALIDATED"))
 I 'VAPRVIEN S LINE=LINE+1 D SET^VALM10(LINE,"PROVIDER NOT MATCHED")
 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=$G(VAPROV(200,VAPIENS,.115,"E"))
 .S VAPZIP=$G(VAPROV(200,VAPIENS,.116,"E"))
 .S VAPNPI=$G(VAPROV(200,VAPIENS,41.99,"E"))
 .S VAPDEA=$G(VAPROV(200,VAPIENS,53.2,"E"))
 .S VAPDEAEX=$$GET1^DIQ(200,VAPIENS,747.44,"I") 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,PSOIEN,1.3,"I")
 .S LINE=LINE+1 D SET^VALM10(LINE,"Vista Provider: "_VAPNM)
 .S LINE=LINE+1 D SET^VALM10(LINE,"Address: "_$S($L(VAPADD1):VAPADD1,1:"No street address on file."))
 .I $L(VAPADD2) S LINE=LINE+1 D SET^VALM10(LINE,"         "_VAPADD2)
 .S LINE=LINE+1 D SET^VALM10(LINE,"         "_VAPCIT_", "_VAPST_" "_VAPZIP)
 .S LINE=LINE+1
 .D ADDITEM^PSOERX1A(.LINETXT,"NPI: ",VAPNPI,1,26)
 .D ADDITEM^PSOERX1A(.LINETXT,"DEA: ",VAPDEA_$S($G(DEAEXP):" (Expired)",1:""),28,26)
 .D SET^VALM10(LINE,LINETXT) S LINETXT=""
 .S LINE=LINE+1
 .D ADDITEM^PSOERX1A(.LINETXT,"Tel: ",VAPTEL,1,26)
 .D ADDITEM^PSOERX1A(.LINETXT,"Fax: ",VAPFAX,28,26)
 .D SET^VALM10(LINE,LINETXT) S LINETXT=""
 S LINE=LINE+1 D SET^VALM10(LINE,"")
 S VALMCNT=LINE
 S EDTYP="PR"
 Q
HELP ; -- help code
 S X="?" D DISP^XQORM1 W !!
 Q
 ;
EXIT ; -- exit code
 K EDTYP,@VALMAR
 Q
 ;
EXPND ; -- expand code
 Q