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