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

PSOERXP1.m

Go to the documentation of this file.
PSOERXP1 ;ALB/BWF - eRx Patient Display/Actions ; 8/3/2016 5:14pm
 ;;7.0;OUTPATIENT PHARMACY;**467,520,527,551,581**;DEC 1997;Build 126
 ;
EN ; -- main entry point for PSO ERX HOLDING QUEUE
 D EN^VALM("PSO ERX PATIENT VALIDATION")
 Q
 ;
HDR ; -- header code
 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" K @VALMAR D INIT S VALMBCK=""
 Q
 ;
INIT ;
 Q:'$G(PSOIEN)
 N LINE,PATDAT,EXPIEN,EXPIENS,EXPNM,EXPDOB,EXPSSN,EXPADD,EXPGEN,EXPCTY,EXPST,EXPZIP,HFIEN,EXPHPH,CPIEN,EXPCPH,LINETXT
 N MANVAL,VAPATIEN,SEPLN,COMM,COMLINE,DONE,TEXT,VAEL,VAELIEN,VAELIG,VAELNM,WORD,VALBY,VALDTTM,PNAR,NARARY,PL,SCRIPTFLG,PRIMARY
 S LINE=0,LINETXT=""
 S EXPIEN=$$GET1^DIQ(52.49,PSOIEN,.04,"I")
 S MANVAL=$$GET1^DIQ(52.49,PSOIEN,1.13,"I")
 S EXPIENS=EXPIEN_","
 D GETS^DIQ(52.46,EXPIENS,"**","E","PATDAT")
 S EXPNM=$G(PATDAT(52.46,EXPIENS,.01,"E"))
 S EXPDOB=$G(PATDAT(52.46,EXPIENS,.08,"E"))
 S EXPSSN=$G(PATDAT(52.46,EXPIENS,1.4,"E"))
 I EXPSSN D
 .I EXPSSN'["-" S EXPSSN=$E(EXPSSN,1,3)_"-"_$E(EXPSSN,4,5)_"-"_$E(EXPSSN,6,9)
 S EXPADD=$G(PATDAT(52.46,EXPIENS,3.1,"E"))
 S EXPGEN=$G(PATDAT(52.46,EXPIENS,.07,"E"))
 S EXPCTY=$G(PATDAT(52.46,EXPIENS,3.3,"E"))
 S EXPST=$G(PATDAT(52.46,EXPIENS,3.4,"E"))
 S EXPZIP=$G(PATDAT(52.46,EXPIENS,3.5,"E")),EXPZIP=$E(EXPZIP,1,5)
 S HFIEN=$O(^PS(52.46,EXPIEN,3,"C","HP",0))
 I $$GET1^DIQ(52.49,PSOIEN,312.1) S SCRIPTFLG=1
 S EXPHPH=$$GET1^DIQ(52.462,HFIEN_","_EXPIENS,.01,"E")
 S CPIEN=$O(^PS(52.46,EXPIEN,3,"C","CP",0))
 S EXPCPH=$$GET1^DIQ(52.462,CPIEN_","_EXPIENS,.01,"E")
 S LINE=LINE+1,LINETXT=""
 D ADDITEM^PSOERX1A(.LINETXT,"eRx Patient: ",$E(EXPNM,1,39),1,52)
 D ADDITEM^PSOERX1A(.LINETXT,"DOB: ",EXPDOB,55,72)
 D SET^VALM10(LINE,LINETXT) S LINETXT=""
 I $L(EXPNM)>39 D
 .S LINE=LINE+1 D SET^VALM10(LINE,"             "_$E(EXPNM,40,78))
 I $L(EXPNM)>78 D
 .S LINE=LINE+1 D SET^VALM10(LINE,"             "_$E(EXPNM,79,135))
 S LINE=LINE+1
 D SET^VALM10(LINE,LINETXT) S LINETXT=""
 D ADDITEM^PSOERX1A(.LINETXT,"Sex: ",EXPGEN,1,15)
 I $G(SCRIPTFLG) S EXPSSN=$$GET1^DIQ(52.46,EXPIEN,18.2)
 D ADDITEM^PSOERX1A(.LINETXT,"SSN: ",EXPSSN,55,65)
 D SET^VALM10(LINE,LINETXT) S LINETXT=""
 S LINE=LINE+1
 D ADDITEM^PSOERX1A(.LINETXT,"Addr: ",$E(EXPADD,1,40),1,50)
 D SET^VALM10(LINE,LINETXT) S LINETXT=""
 S LINE=LINE+1
 D ADDITEM^PSOERX1A(.LINETXT,"City: ",$E(EXPCTY,1,35),1,45)
 D SET^VALM10(LINE,LINETXT) S LINETXT=""
 S LINE=LINE+1
 D ADDITEM^PSOERX1A(.LINETXT,"St: ",$E(EXPST,1,35),1,45)
 D ADDITEM^PSOERX1A(.LINETXT,"Zip: ",EXPZIP,55,75)
 D SET^VALM10(LINE,LINETXT) S LINETXT=""
 S LINE=LINE+1
 I $G(SCRIPTFLG) D
 .S EXPHPH=$$COMMVAL^PSOERXU5(EXPIEN,52.46,13,"HT")
 D ADDITEM^PSOERX1A(.LINETXT,"Home Phone: ",EXPHPH,1,25)
 I $G(SCRIPTFLG) D
 .S PRIMARY=$$COMMVAL^PSOERXU5(EXPIEN,52.46,13,"PT")
 .D ADDITEM^PSOERX1A(.LINETXT,"Primary Phone: ",PRIMARY,55,75)
 I '$G(SCRIPTFLG) D ADDITEM^PSOERX1A(.LINETXT,"Cell Phone: ",EXPCPH,55,75)
 D SET^VALM10(LINE,LINETXT) S LINETXT=""
 S LINE=LINE+1 D SET^VALM10(LINE,"")
 S $P(SEPLN,"-",80)="-" D SET^VALM10(LINE,SEPLN)
 ; vista patient information
 S VAPATIEN=$$GET1^DIQ(52.49,PSOIEN,.05,"I")
 I VAPATIEN D
 .S DFN=VAPATIEN D DEM^VADPT,ADD^VADPT,ELIG^VADPT
 .S VAELIG=$G(VAEL(1)),VAELIEN=$P(VAELIG,U),VAELNM=$P(VAELIG,U,2)
 S MANVAL=$$GET1^DIQ(52.49,PSOIEN,1.7,"I")
 S VALBY=$$GET1^DIQ(52.49,PSOIEN,1.13,"E")
 S VALDTTM=$$GET1^DIQ(52.49,PSOIEN,1.14,"E")
 S LINE=LINE+1 D SET^VALM10(LINE,"Status: "_$S(MANVAL:"VALIDATED ("_VALBY_" - "_VALDTTM_")",1:"NOT VALIDATED"))
 I 'VAPATIEN D
 .S LINE=LINE+1 D SET^VALM10(LINE,"PATIENT NOT MATCHED")
 .S LINE=LINE+1 D SET^VALM10(LINE,"Allergies:")
 .S LINE=LINE+1 D SET^VALM10(LINE,"Adverse Reactions:")
 I VAPATIEN D
 .S LINE=LINE+1
 .D ADDITEM^PSOERX1A(.LINETXT,"Vista Patient: ",$G(VADM(1)),1,53)
 .D ADDITEM^PSOERX1A(.LINETXT,"DOB: ",$P($G(VADM(3)),U,2),55,20)
 .D SET^VALM10(LINE,LINETXT) S LINETXT=""
 .S LINE=LINE+1
 .D ADDITEM^PSOERX1A(.LINETXT,"Sex: ",$P($G(VADM(5)),U,2),1,20)
 .D ADDITEM^PSOERX1A(.LINETXT,"SSN: ",$P($G(VADM(2)),U,2),55,20)
 .D SET^VALM10(LINE,LINETXT) S LINETXT=""
 .S LINE=LINE+1
 .D ADDITEM^PSOERX1A(.LINETXT,"Addr: ",$P($G(VAPA(1)),U),1,70)
 .D SET^VALM10(LINE,LINETXT) S LINETXT=""
 .S LINE=LINE+1
 .D ADDITEM^PSOERX1A(.LINETXT,"City: ",$P($G(VAPA(4)),U),1,25)
 .D SET^VALM10(LINE,LINETXT) S LINETXT=""
 .S LINE=LINE+1
 .D ADDITEM^PSOERX1A(.LINETXT,"St: ",$P(VAPA(5),U,2),1,20)
 .D ADDITEM^PSOERX1A(.LINETXT,"Zip: ",$P($G(VAPA(6)),U),55,10)
 .D SET^VALM10(LINE,LINETXT) S LINETXT=""
 .S LINE=LINE+1
 .D ADDITEM^PSOERX1A(.LINETXT,"Home Phone: ",$P($G(VAPA(8)),U),1,25)
 .D ADDITEM^PSOERX1A(.LINETXT,"Cell Phone: ",$$GET1^DIQ(2,VAPATIEN,.134,"E"),55,80)
 .D SET^VALM10(LINE,LINETXT) S LINETXT=""
 .S LINE=LINE+1 D SET^VALM10(LINE,"")
 .S LINE=LINE+1 D SET^VALM10(LINE,"Eligibility: "_$G(VAELNM))
 .S PNAR="Pharmacy Narrative: "_$$GET1^DIQ(55,VAPATIEN,1,"E")
 .D TXT2ARY^PSOERXD1(.NARARY,PNAR,,80)
 .S PL=0 F  S PL=$O(NARARY(PL)) Q:'PL  S LINE=LINE+1 D SET^VALM10(LINE,$G(NARARY(PL)))
 .I $$GET1^DIQ(52.49,PSOIEN,.05,"I") D
 ..D ALG^PSOERXU1(.LINE)
 S VALMCNT=LINE
 S EDTYP="P"
 K VAPA,VADM,DFN,VA
 Q
HELP ; -- help code
 S X="?" D DISP^XQORM1 W !!
 Q
 ;
EXIT ; -- exit code
 K EDTYP,@VALMAR
 Q
 ;
EXPND ; -- expand code
 Q