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

PSOERXU1.m

Go to the documentation of this file.
PSOERXU1 ;ALB/BWF - eRx utilities ; 1/27/2019 11:03am
 ;;7.0;OUTPATIENT PHARMACY;**467,520,508,551,565,581**;DEC 1997;Build 126
 ;
 Q
 ; OR0 - OR0 FROM PENDING OUTPATIENT ORDERS OR BACKDOOR ORDERS
 ; OR0 can also be just the order number
CHKERX(OR0) ;
 N ORIEN,ERXIEN
 S ORIEN=$P(OR0,U) Q:'ORIEN 0
 I '$D(^PS(52.49,"ORN",ORIEN)) Q 0
 S ERXIEN=$O(^PS(52.49,"ORN",ORIEN,0))
 I 'ERXIEN Q 0
 Q ERXIEN
PROVPMT(ERXIEN) ;
 N ERXPHYS,ERXPHNM,ERXCON,DIR,Y,OLDQUIT,NEWQUIT,COMMIEN,PHONECHK
 S OLDQUIT=0,NEWQUIT=0
 S $P(LINE,"*",80)="" W !!,LINE
 S S2017=$$GET1^DIQ(52.49,ERXIEN,312.1)
 W !!,"This prescription is an inbound electronic prescription (eRx).",!,"Please contact the original provider for approval to renew."
 S ERXPHYS=$$GET1^DIQ(52.49,ERXIEN,2.1,"I")
 S ERXPHNM=$$GET1^DIQ(52.48,ERXPHYS,.01,"E") W !,ERXPHNM
 I '$G(S2017) D
 .I '$D(^PS(52.48,ERXPHYS,3,"C","TE")) W !!,"No telephone information on file for this provider." D
 ..S OLDQUIT=1
 I OLDQUIT=1 Q 0
 I $G(S2017) D
 .S PHONECHK=$$COMMVAL^PSOERXU5(ERXPHYS,52.48,11,"PT")
 .I '$G(PHONECHK) S NEWQUIT=1
 I NEWQUIT=1 Q 0
 W !
 S ERXCON=0 F  S ERXCON=$O(^PS(52.48,ERXPHYS,3,"C","TE",ERXCON)) Q:'ERXCON  D
 .W !,"Telephone: "_$$GET1^DIQ(52.483,ERXCON_","_ERXPHYS_",",.01,"E")
 W !!,"Answering 'Yes' indicates you have contacted the prescribing physician"
 S DIR(0)="Y",DIR("B")="NO",DIR("A")="Would you like to proceed with renewing this prescription" D ^DIR K DIR
 I Y=1 Q 1
 Q 0
DERX1(GL,PSOIEN,DFLG,IEN) ;
 N EDRG,ERXDAT,ESIG,COMM,SUBS,DFORM,DSTR,QQUAL,POTUC,QTY,DAYS,REFILL,PSOIENS,LINE,LINETXT,ADLINE,ADARY,ALOOP,COMMARY
 N ERXPAT,ERXPIEN,ERXPDOB,ERXPSSN,ERXPROV,ERXPRIEN,ERXPRDEA,ERXPRNPI,ERXPRSA1,ERXPRSA2,ERXPRCTY,ERXPRST,ERXPRZIP,I
 N PROVDAT,SIGARY,STHIS,STAT,ACBY,FOUND,ACDTTM,DRGARY,DLP,CTYSTZIP,ADLINE1,MTYPE,ERXDSUB,S2017,PHW,MIEN,ERXEFFDT,ERXWDATE
 N PROHIBIT,SGLOOP
 Q:'PSOIEN
 S PSOIENS=PSOIEN_","
 D GETS^DIQ(52.49,PSOIENS,".04;.08;2.1;3.1;4.6;4.8;5.1;5.2;5.4;5.5;5.6;5.7;5.8;7;8;41;42;43;312.1","IE","ERXDAT")
 S S2017=$G(ERXDAT(52.49,PSOIENS,312.1,"I"))
 S DFLG=$G(DFLG,"")
 S EDRG=$G(ERXDAT(52.49,PSOIENS,3.1,"E"))
 S ESIG=$G(ERXDAT(52.49,PSOIENS,7,"E"))
 S COMM=$G(ERXDAT(52.49,PSOIENS,8,"E"))
 S SUBS=$G(ERXDAT(52.49,PSOIENS,5.8,"E"))
 S DFORM=$G(ERXDAT(52.49,PSOIENS,41,"E"))
 S DSTR=$G(ERXDAT(52.49,PSOIENS,43,"E"))
 S MTYPE=$G(ERXDAT(52.49,PSOIENS,.08,"I"))
 I 'S2017 D
 .S QQUAL=$G(ERXDAT(52.49,PSOIENS,5.2,"E"))
 I S2017 D
 .I MTYPE'="RE" S MIEN=$O(^PS(52.49,PSOIEN,311,"C","P",0))
 .I MTYPE="RE" S MIEN=$O(^PS(52.49,PSOIEN,311,"C","MR",0))
 .S QQUAL=$$GET1^DIQ(52.49311,MIEN_","_PSOIEN_",",2.2,"I"),QQUAL=$$GET1^DIQ(52.45,QQUAL,.02,"E")
 S POTUC=$G(ERXDAT(52.49,PSOIENS,42,"E"))
 S QTY=$G(ERXDAT(52.49,PSOIENS,5.1,"E"))
 S DAYS=$G(ERXDAT(52.49,PSOIENS,5.5,"E"))
 S REFILL=$G(ERXDAT(52.49,PSOIENS,5.6,"E"))
 I MTYPE="RE",REFILL>0 S REFILL=REFILL-1
 I '$$GET1^DIQ(52.49,PSOIEN,312.1) D
 .I REFILL="" D
 ..S REFILL=$G(ERXDAT(52.49,PSOIENS,5.7,"I"))
 S ERXPAT=$G(ERXDAT(52.49,PSOIENS,.04,"E"))
 S ERXPIEN=$G(ERXDAT(52.49,PSOIENS,.04,"I"))
 S ERXPDOB=$$GET1^DIQ(52.46,ERXPIEN,.08,"E")
 S ERXPSSN=$$GET1^DIQ(52.46,ERXPIEN,$S(S2017:18.2,1:1.4),"E")
 S ERXPROV=$G(ERXDAT(52.49,PSOIENS,2.1,"E"))
 S ERXPRIEN=$G(ERXDAT(52.49,PSOIENS,2.1,"I"))
 N FIELDS
 S FIELDS=$S(2017:"14.5;15.1",1:"1.5;1.6")_";4.1;4.2;4.3;4.4;4.5"
 D GETS^DIQ(52.48,ERXPRIEN_",",FIELDS,"E","PROVDAT")
 I S2017 D
 .S ERXPRDEA=$G(PROVDAT(52.48,ERXPRIEN_",",14.5,"E"))
 .S ERXPRNPI=$G(PROVDAT(52.48,ERXPRIEN_",",15.1,"E"))
 I 'S2017 D
 .S ERXPRDEA=$G(PROVDAT(52.48,ERXPRIEN_",",1.6,"E"))
 .S ERXPRNPI=$G(PROVDAT(52.48,ERXPRIEN_",",1.5,"E"))
 S ERXPRSA1=$G(PROVDAT(52.48,ERXPRIEN_",",4.1,"E"))
 S ERXPRSA2=$G(PROVDAT(52.48,ERXPRIEN_",",4.2,"E"))
 S ERXPRCTY=$G(PROVDAT(52.48,ERXPRIEN_",",4.3,"E"))
 S ERXPRST=$G(PROVDAT(52.48,ERXPRIEN_",",4.4,"E"))
 S ERXPRZIP=$G(PROVDAT(52.48,ERXPRIEN_",",4.5,"E"))
 D TXT2ARY^PSOERXD1(.SIGARY,ESIG,,69)
 D TXT2ARY^PSOERXD1(.COMMARY,COMM,,65)
 S STHIS=99999,FOUND=0
 F  S STHIS=$O(^PS(52.49,PSOIEN,19,STHIS),-1) Q:'STHIS!(FOUND)  D
 .S STAT=$$GET1^DIQ(52.4919,STHIS_","_PSOIENS,.02,"I")
 .I ",PR,RXP,CXP,"[(","_$$GET1^DIQ(52.45,STAT,.01,"E")_",") D
 ..S ACDTTM=$$GET1^DIQ(52.4919,STHIS_","_PSOIENS,.01,"E")
 ..S ACBY=$$GET1^DIQ(52.4919,STHIS_","_PSOIENS,.03,"E"),FOUND=1
 I $L($G(ACBY)) S IEN=IEN+1,@GL@(IEN,0)="eRx Accepted By: "_ACBY_" ("_ACDTTM_")"
 S LINETXT=""
 D ADDITEM^PSOERX1A(.LINETXT,"eRx Patient: ",ERXPAT,1,55)
 D ADDITEM^PSOERX1A(.LINETXT,"SSN: ",ERXPSSN,57,15)
 S IEN=IEN+1,@GL@(IEN,0)=LINETXT
 S LINETXT=""
 I $L(ERXPAT)>42 D ADDITEM^PSOERX1A(.LINETXT,"             ",$E(ERXPAT,43,84),1,55)
 D ADDITEM^PSOERX1A(.LINETXT,"DOB: ",ERXPDOB,57,20)
 S IEN=IEN+1,@GL@(IEN,0)=LINETXT
 I $L(ERXPAT)>84 D
 .S IEN=IEN+1,@GL@(IEN,0)="             "_$E(ERXPAT,85,117)
 I $L(ERXPAT)>117 D
 .S IEN=IEN+1,@GL@(IEN,0)="             "_$E(ERXPAT,118,135)
 S IEN=IEN+1,@GL@(IEN,0)=""
 I S2017 D
 .S PHW=$$BHW^PSOERXIU(PSOIEN) S IEN=IEN+1,@GL@(IEN,0)=PHW
 S LINETXT=""
 D ADDITEM^PSOERX1A(.LINETXT,"eRx Provider: ",$E(ERXPROV,1,55),1,55)
 D ADDITEM^PSOERX1A(.LINETXT,"DEA: ",ERXPRDEA,57,20)
 S IEN=IEN+1,@GL@(IEN,0)=LINETXT,LINETXT=""
 I $L(ERXPROV)>55 D ADDITEM^PSOERX1A(.LINETXT,"              ",$E(ERXPROV,56,96),1,55)
 D ADDITEM^PSOERX1A(.LINETXT,"NPI: ",ERXPRNPI,57,20)
 S IEN=IEN+1,@GL@(IEN,0)=LINETXT,LINETXT=""
 I $L(ERXPROV)>96 D ADDITEM^PSOERX1A(.LINETXT,"              ",$E(ERXPROV,97,135),1,55)
 S IEN=IEN+1,@GL@(IEN,0)=LINETXT,LINETXT=""
 S ADLINE1=$S($L(ERXPRSA1):ERXPRSA1,1:"ADDRESS UNKNOWN ")
 S CTYSTZIP=$S($L(ERXPRCTY):ERXPRCTY_",",1:"")
 S CTYSTZIP=CTYSTZIP_$S($L(ERXPRST):ERXPRST_" ",1:"")
 S CTYSTZIP=" "_CTYSTZIP_$S($L(ERXPRZIP):ERXPRZIP,1:"")
 S IEN=IEN+1,@GL@(IEN,0)="Address: "_ADLINE1
 S IEN=IEN+1,@GL@(IEN,0)=CTYSTZIP
 I $L(ERXPRSA2) D
 .S IEN=IEN+1,@GL@(IEN,0)="Address Line 2: "_ERXPRSA2
 I $O(ADARY(0)) D
 .S ALOOP=1 F  S ALOOP=$O(ADARY(ALOOP)) Q:'ALOOP  D
 ..S IEN=IEN+1,@GL@(IEN,0)="         "_ADARY(ALOOP)
 S IEN=IEN+1,@GL@(IEN,0)=""
 D TXT2ARY^PSOERXD1(.DRGARY,EDRG,,70)
 S IEN=IEN+1,@GL@(IEN,0)="eRx Drug: "_$G(DRGARY(1))
 S DLP=1
 F  S DLP=$O(DRGARY(DLP)) Q:'DLP  D
 .S IEN=IEN+1,@GL@(IEN,0)="          "_$G(DRGARY(DLP))
 S LINETXT=""
 D ADDITEM^PSOERX1A(.LINETXT,"Qty: ",QTY,1,25)
 D ADDITEM^PSOERX1A(.LINETXT,"Days Supply: ",DAYS,27,16)
 D ADDITEM^PSOERX1A(.LINETXT,"Refills: ",REFILL,58,20)
 S IEN=IEN+1,@GL@(IEN,0)=LINETXT
 I 'S2017 D
 .S IEN=IEN+1,@GL@(IEN,0)="eRx Written Date: "_$$FMTE^XLFDT($P($$GET1^DIQ(52.49,PSOIEN,5.9,"I"),"@"),"2D")_"              eRx Received Date: "_$$FMTE^XLFDT($P($$GET1^DIQ(52.49,PSOIEN,.03,"I"),"@"),"2D")
 I S2017 D
 .S MIEN=$O(^PS(52.49,PSOIEN,311,0))
 .S ERXEFFDT=$$EFFDATE^PSOERXU5(PSOIEN,MIEN)
 .S ERXWDATE=$$GET1^DIQ(52.49,PSOIEN,5.9,"I")
 .W !,"eRx Written Date: "_$$FMTE^XLFDT($P(ERXWDATE,"."),1)_"              eRx Issue Date: "_ERXEFFDT
 S ERXDSUB=$$GET1^DIQ(52.49,PSOIEN,5.8,"I")
 S ERXDSUB=$S(ERXDSUB=1:"NO",ERXDSUB=0:"YES",1:"")
 S LINETXT=""
 D ADDITEM^PSOERX1A(.LINETXT,"Substitutions? :",ERXDSUB,1,25)
 S IEN=IEN+1,@GL@(IEN,0)=LINETXT
 I 'S2017 D
 .S IEN=IEN+1,@GL@(IEN,0)="eRx Sig: "
 .S I=0 F  S I=$O(SIGARY(I)) Q:'I  D
 ..I I=1 S @GL@(IEN,0)=@GL@(IEN,0)_SIGARY(I) Q
 ..S IEN=IEN+1,@GL@(IEN,0)=$S(I>1:"         "_SIGARY(I),1:SIGARY(I))
 .I '$L(ESIG) S IEN=IEN+1,@GL@(IEN,0)=""
 I S2017,MTYPE?1(1"N",1"RE",1"CX") D
 .I MTYPE?1(1"N",1"CX") D
 ..S PROHIBIT=$$GET1^DIQ(52.49,PSOIEN,301.3,"I")
 ..S PROHIBIT=$S(PROHIBIT=1:"Yes",1:"No")
 ..S IEN=IEN+1,@GL@(IEN,0)="Prohibit Renewals: "_PROHIBIT
 ..S IEN=IEN+1,@GL@(IEN,0)=""
 .S IEN=IEN+1,@GL@(IEN,0)="eRx Sig:"
 .S SGLOOP=0 F  S SGLOOP=$O(^PS(52.49,PSOIEN,311,MIEN,8,SGLOOP)) Q:'SGLOOP  D
 ..S IEN=IEN+1,@GL@(IEN,0)=$G(^PS(52.49,PSOIEN,311,MIEN,8,SGLOOP,0))
 .S IEN=IEN+1,@GL@(IEN,0)=""
 S IEN=IEN+1,@GL@(IEN,0)="eRx Notes: "
 S I=0 F  S I=$O(COMMARY(I)) Q:'I  D
 .I I=1 S @GL@(IEN,0)=@GL@(IEN,0)_$S(I>1:"              "_COMMARY(I),1:COMMARY(I)) Q
 .S IEN=IEN+1,@GL@(IEN,0)=$S(I>1:"              "_COMMARY(I),1:COMMARY(I))
 I '$L(COMM) S IEN=IEN+1,@GL@(IEN,0)=""
 Q:DFLG=1
 S LINETXT=""
 S IEN=IEN+1,@GL@(IEN,0)=""
 S IEN=IEN+1,@GL@(IEN,0)="Drug Form: "_DFORM
 S IEN=IEN+1,@GL@(IEN,0)="Strength: "_DSTR
 S LINETXT=""
 S IEN=IEN+1,@GL@(IEN,0)="Code List Qualifier: "_QQUAL
 S IEN=IEN+1,@GL@(IEN,0)="Quantity Unit of Measure: "_POTUC
 S IEN=IEN+1,@GL@(IEN,0)=LINETXT
 S ERXDSUB=$$GET1^DIQ(52.49,PSOIEN,5.8,"I")
 S ERXDSUB=$S(ERXDSUB=1:"NO",ERXDSUB=0:"YES",1:"")
 S IEN=IEN+1,@GL@(IEN,0)="Substitutions?: "_ERXDSUB
 S IEN=IEN+1,@GL@(IEN,0)=""
 I '$G(S2017) D DIAG(PSOIEN,.IEN,.GL)
 I $G(S2017),MIEN D DIAG2017^PSOERXU5(PSOIEN,.IEN,.GL,MIEN)
 S $P(LINE,"-",80)=""
 S IEN=IEN+1,@GL@(IEN,0)=LINE
 Q
 ; diagnosis information
DIAG(PSOIEN,LINE,GL) ;
 N DIAGIEN,DIAGDAT,DIAGSEQ,PDIAGQ,PDIAGV,SDIAGQ,SDIAGV,DIAGDAT,DIACIC,DRES,SDRES,PDIAGTXT,SDIAGTXT
 N SDRESL,SDRESDAT,DRESL,DRESDAT,PDIAGARY,SDIAGARY,PDFRST,SDFRST,PDLOOP,SDLOOP,DIENS
 S DIAGIEN=0 F  S DIAGIEN=$O(^PS(52.49,PSOIEN,9,DIAGIEN)) Q:'DIAGIEN  D
 .S DIENS=DIAGIEN_","_PSOIEN_"," K PDIAGARY,SDIAGARY,DIAGDAT
 .D GETS^DIQ(52.499,DIENS,".01:.06","IE","DIAGDAT")
 .S DIAGSEQ=$G(DIAGDAT(52.499,DIENS,.01,"E"))
 .S DIACIC=$G(DIAGDAT(52.499,DIENS,.02,"E"))
 .S PDIAGQ=$G(DIAGDAT(52.499,DIENS,.03,"E"))
 .S PDIAGV=$G(DIAGDAT(52.499,DIENS,.04,"E"))
 .I PDIAGQ["ICD" D
 ..K DRES,PDIAGARY
 ..D ICDDESC^ICDXCODE(PDIAGQ,PDIAGV,,.DRES)
 ..I '$O(DRES(0)) D TXT2ARY^PSOERXD1(.PDIAGARY,"Primary Dx:   ("_PDIAGQ_" - "_PDIAGV_")"," ",78) Q
 ..S PDIAGTXT="Primary Dx:   ("_PDIAGQ_" "_PDIAGV_") "
 ..S DRESL=0 F  S DRESL=$O(DRES(DRESL)) Q:'DRESL  D
 ...S DRESDAT=$G(DRES(DRESL)) Q:DRESDAT=""
 ...S PDIAGTXT=$G(PDIAGTXT)_" "_DRESDAT
 ..D TXT2ARY^PSOERXD1(.PDIAGARY,PDIAGTXT," ",78)
 .S SDIAGQ=$G(DIAGDAT(52.499,DIENS,.05,"E"))
 .S SDIAGV=$G(DIAGDAT(52.499,DIENS,.06,"E"))
 .I SDIAGQ["ICD" D
 ..K SDRES,SDIAGARY
 ..D ICDDESC^ICDXCODE(SDIAGQ,SDIAGV,,.SDRES)
 ..I '$O(DRES(0)) D TXT2ARY^PSOERXD1(.SDIAGARY,"Secondary Dx: ("_SDIAGQ_" - "_SDIAGV_")"," ",78) Q
 ..S SDIAGTXT="Secondary Dx: ("_SDIAGQ_" "_SDIAGV_") "
 ..S SDRESL=0 F  S SDRESL=$O(SDRES(SDRESL)) Q:'SDRESL  D
 ...S SDRESDAT=$G(SDRES(SDRESL)) Q:SDRESDAT=""
 ...S SDIAGTXT=$G(SDIAGTXT)_" "_SDRESDAT
 ..D TXT2ARY^PSOERXD1(.SDIAGARY,SDIAGTXT," ",78)
 .I '$D(PDIAGARY) D TXT2ARY^PSOERXD1(.PDIAGARY,"Primary Dx:   ("_PDIAGQ_" - "_PDIAGV_")"," ",78)
 .S PDFRST=$O(PDIAGARY(0))
 .S LINE=LINE+1
 .I $D(GL) D SETGL(LINE,PDIAGARY(PDFRST))
 .I '$D(GL) D SETLOC(LINE,$G(PDIAGARY(PDFRST)))
 .S PDLOOP=PDFRST F  S PDLOOP=$O(PDIAGARY(PDLOOP)) Q:'PDLOOP  D
 ..S LINE=LINE+1
 ..I $D(GL) D SETGL(LINE,"              "_$G(PDIAGARY(PDLOOP)))
 ..I '$D(GL) D SETLOC(LINE,"              "_$G(PDIAGARY(PDLOOP)))
 .S LINE=LINE+1
 .I $D(GL) D SETGL(LINE,"")
 .I '$D(GL) D SETLOC(LINE,"")
 .I '$D(SDIAGARY) D TXT2ARY^PSOERXD1(.SDIAGARY,"Secondary Dx: ("_SDIAGQ_" - "_SDIAGV_")"," ",78)
 .S SDFRST=$O(SDIAGARY(0))
 .S LINE=LINE+1
 .I $D(GL) D SETGL(LINE,$G(SDIAGARY(SDFRST)))
 .I '$D(GL) D SETLOC(LINE,$G(SDIAGARY(SDFRST)))
 .S SDLOOP=SDFRST F  S SDLOOP=$O(SDIAGARY(SDLOOP)) Q:'SDLOOP  D
 ..S LINE=LINE+1
 ..I $D(GL) D SETGL(LINE,"              "_$G(SDIAGARY(SDLOOP)))
 ..I '$D(GL) D SETLOC(LINE,"              "_$G(SDIAGARY(SDLOOP)))
 .I $O(^PS(52.49,PSOIEN,9,DIAGIEN)) D
 ..S LINE=LINE+1
 ..I $D(GL) D SETGL(LINE,"")
 ..I '$D(GL) D SETLOC(LINE,"")
 Q
SETLOC(LINE,TEXT) ;
 D SET^VALM10(LINE,TEXT)
 Q
SETGL(IEN,TEXT) ;
 S @GL@(IEN,0)=TEXT
 Q
OPACCESS(OPTION,DUZ,ERXIEN) ;
 N ERXIEN2
 S ERXIEN2=$G(ERXIEN)
 Q $$OPACCESS^PSOERXU7(OPTION,DUZ,ERXIEN2)
 ; update the status of an eRx
 ; PSOIEN - ien for file 52.49 (required)
 ; STAT - The status value to change the eRx to (required)
 ; SCOMM - status comments (optional)
UPDSTAT(PSOIEN,STAT,SCOMM) ;
 N DIE,NSTAT,DA,DR,FDA
 Q:'PSOIEN!(STAT="")
 Q:'$D(^PS(52.45,"C","ERX",STAT))
 S NSTAT=$O(^PS(52.45,"C","ERX",STAT,0))
 S DIE="^PS(52.49,",DA=PSOIEN,DR="1///"_NSTAT D ^DIE
 S FDA(52.4919,"+1,"_PSOIEN_",",.01)=$$NOW^XLFDT
 S FDA(52.4919,"+1,"_PSOIEN_",",.02)=NSTAT
 S FDA(52.4919,"+1,"_PSOIEN_",",.03)=$G(DUZ)
 S FDA(52.4919,"+1,"_PSOIEN_",",1)=$G(SCOMM)
 D UPDATE^DIE(,"FDA") K FDA
 Q
ERRSEQ(EIEN) ;
 N SEQ
 I '$O(^PS(52.49,EIEN,100,0)) S SEQ=1
 I '$G(SEQ) S SEQ=$O(^PS(52.49,EIEN,100,999999),-1)+1
 Q SEQ
 ;
 ; IENS - ien of the erx holding queue entry
 ;  SEQ - sequence number of the error
 ; TYPE - type (d-drug, pr-provider, pa-patient, a-allergy, o-order check, t-transfer)
 ;  SRC - v - vista, e - erx processing hub
 ;  TXT - error text
FILERR(IENS,SEQ,TYPE,SRC,TXT) ;
 N FDA
 S FDA(52.49101,"+1,"_IENS,.01)=SEQ
 S FDA(52.49101,"+1,"_IENS,.02)=TYPE
 S FDA(52.49101,"+1,"_IENS,.03)=SRC
 ; all new errors are set to pending
 S FDA(52.49101,"+1,"_IENS,.04)="P"
 S FDA(52.49101,"+1,"_IENS,1)=TXT
 D UPDATE^DIE(,"FDA") K FDA
 ; now set the eRx entry status to error
 Q
MSGDIR(MSG) ;
 N DIR,MLOOP,MTXT
 S VALMBCK="R"
 D FULL^VALM1
 W !!,"Errors encountered during processing:",!
 S MLOOP=0 F  S MLOOP=$O(MSG(MLOOP)) Q:'MLOOP  D
 .S MTXT=$G(MSG(MLOOP)) W !,MLOOP_".) ",MTXT
 W !!,"Cannot process eRx.",!
 S DIR(0)="E" D ^DIR
 Q
 ; provider change screen on refill response
CHPRCHG(ERXIEN) ;
 N REQIEN,RESIEN,DELTA,MTYPE,RESVAL,MSTAT
 S MTYPE=$$GET1^DIQ(52.49,ERXIEN,.08,"I")
 S MSTAT=$$GET1^DIQ(52.49,ERXIEN,1,"E")
 S RESVAL=$$GET1^DIQ(52.49,ERXIEN,52.1,"I")
 I MTYPE="RE",((RESVAL="D")!(RESVAL="DNP")) Q 0
 I MTYPE="RR"!(MTYPE="CA")!(MTYPE="CN")!(MTYPE="IE") Q 0
 I MTYPE'="RE" Q 1
 I MTYPE="RE",RESVAL="R",MSTAT'="RXP" Q 1
 I MTYPE="RE",MSTAT="RXW" Q 1
 I RESVAL'="AWC",MTYPE="RE",",RXP,RXC,RXD,"[MSTAT Q 0
 I MTYPE="RE",($$GET1^DIQ(52.49,ERXIEN,52.1,"I")'["A") Q 0
 S RESIEN=ERXIEN,REQIEN=$$GETREQ^PSOERXU2(ERXIEN)
 D RRDELTA^PSOERXU2(.DELTA,REQIEN,RESIEN) Q:'$D(DELTA) 0
 I $D(DELTA(52.49,"EXTERNAL PROVIDER")) Q 1
 Q 0
ALG(LINE) ;
 N ALGINFO,ALGLINE,DFN,IEN,X,LDAT,GMRAL,PSONOAL
 S ALGLINE=""
 S DFN=$$GET1^DIQ(52.49,PSOIEN,.05,"I")
 D EN1^GMRADPT
 S IEN=1
 I 'GMRAL D
 .S IEN=IEN+1,^TMP("PSOPI",$J,IEN,0)="Allergies: "_$S(GMRAL=0:"NKA",1:"")
 .I GMRAL'=0 S PSONOAL="" D ALLERGY^PSOORUT2 I PSONOAL'="" S ^TMP("PSOPI",$J,IEN,0)="Allergies: "_PSONOAL K PSONOAL
 .S IEN=IEN+1,^TMP("PSOPI",$J,IEN,0)=" "
 .D REMOTE^PSOORUT2
 .S IEN=IEN+1,^TMP("PSOPI",$J,IEN,0)="Adverse Reactions:"
 D:$G(GMRAL) ^PSOORUT3
 S LINE=LINE+1
 S X=0 F  S X=$O(^TMP("PSOPI",$J,X)) Q:'X  D
 .S LDAT=$G(^TMP("PSOPI",$J,X,0))
 .S LINE=LINE+1
 .D SET^VALM10(LINE,LDAT)
 K ^TMP("PSOPI",$J)
 Q