PSOERX1F ;ALB/MR - Accept/Un-Accept eRx function ; 8/18/2020 5:14pm
;;7.0;OUTPATIENT PHARMACY;**617,651,700,746,770**;DEC 1997;Build 145
;
Q
;PSOHY("LOC")=IEN of hospital location file (#44) - NOT USED,
;PSOHY("CHNUM")=EXTERNAL PLACER ORDER NUMBER (NEED TO FIND OUT HOW WE SHOULD SET THIS) (25)
;PSOHY("PICK")=MAIL/WINDOW (20.4)
;PSOHY("ENTER")=ENTERED BY IEN (2.1)
;PSOHY("PROV")=PROVIDER IEN (2.3)
;PSOHY("SDT")=EFFECTIVE DATE (6.3)
;PSOHY("ITEM")=PHARMACY ORDERABLE ITEM (DERIVED FROM THE DRUG IEN) - NO MAPPING TO 52.49
;PSOHY("DRUG")=DRUG IEN (3.2)
;PSOHY("QTY")=QUANTITY (20.1)
;PSOHY("REF")=# OF REFILLS (20.5)
;PSOHY("PAT")=PATIENT IEN (.05)
;PSOHY("OCC")=ORDER TYPE (ALWAYS 'NW') - NO MAPPING TO 52.49
;PSOHY("EDT")=LOGIN DATE/TIME (ERX MSG DATE/TIME #.03)
;PSOHY("PRIOR")=PRIORITY (SET OF CODES, 52.41,25 - STAT, EMERGENCY, ROUTINE)
;PSOHY("EXAPP")=EXTERNAL APPLICATION (FREE TEXT), LIKELY "PSO" - NO MAPPING TO 52.49
;PSOHY("PRCOM",#)=PROVIDER COMMENTS (8- NOTES)
;PSOHY("SIG",#)=SIG (52.4911 (STRUCTURED SIG), FIELD 1 (SIG FREE TEXT)
;PSOHY("QTSUB",CNT)=QUANTITY TIMING SUBFILE DATA. MERGED IN, FULL SUBFILE DATA
;PSOHY("IND")=INDICATION FOR USE (29)
;PSOHY("INDO")=OTHER LANG INDICATION FOR USE (29.2)
; QUANTITY/TIMING MAPS DIRECTLY TO QUANTITY TIMING IN 52.41
SETUP ;
N MBMSITE,PSOIENS,PSODAT,F,PATIEN,PROVIEN,OC,VQTY,EFFDT,VADRUG,VAOI,VAREF,VAROUT,VAPRIOR,PSOHY,LOC,ERXNUM,PRVARY,PRVCOMM
N PLOOP,PCNT,QTLOOP,QTCNT,PSOEXMS,DIR,ORDERTYP,PSOEXCNT,SCNT,SIGDAT,SLOOP,POORD,PMVAL,PRMVAL,DMVAL,PATINST,RXSTAT
N VADAYS,UNEXPI,PINARY,WRITDT,SLOOP2,MTYPE,REQIEN,ORXIEN,RESTYPE,DELTAS,RXIEN,ERXMSG,I,CSERRMSG,PSOQUIT,DIC,PAINDFU,INDARY,SLOOP3
S MBMSITE=$S($$GET1^DIQ(59.7,1,102,"I")="MBM":1,1:0)
S F=52.49
Q:'$G(PSOIEN)
D FULL^VALM1 I MBMSITE S VALMBCK="R"
I $$DONOTFIL^PSOERXUT(PSOIEN) Q
S RXSTAT=$$GET1^DIQ(52.49,PSOIEN,1,"E")
I RXSTAT="RJ"!(RXSTAT="RM")!($E(RXSTAT,1,3)="REM")!(RXSTAT="PR")!(RXSTAT="CXP")!(RXSTAT="RXP") D Q
. W !!,"Cannot accept a prescription with a status of 'Rejected', 'Removed',",!,"or 'Processed",!
. S DIR(0)="E" D ^DIR
S PSOIENS=PSOIEN_","
D GETS^DIQ(F,PSOIENS,".01;.05;.07;.08;1;1.3;1.5;1.7;2.1;2.3;3.2;5.9;6.2;6.3;8;20.1;20.2;20.4;20.5;20.6;25;25.2;27;29;29.1;29.2;30;52.1","IE","PSODAT")
S PSOEXCNT=0
S MTYPE=$G(PSODAT(F,PSOIENS,.08,"I"))
S RESTYPE=$G(PSODAT(F,PSOIENS,52.1,"I"))
I MTYPE="RE",RESTYPE'="R" D Q
.S REQIEN=$$GETREQ^PSOERXU2(PSOIEN)
.I REQIEN S RXIEN=$$GET1^DIQ(52.49,REQIEN,.13,"I")
.D PREFRES^PSOERXU3(PSOIEN,.PSOHY,.PSOEXCNT,.PSOEXMS,.PSODAT)
.I $G(PSODAT(F,PSOIENS,2.3,"I")) S PSOHY("PROV")=$G(PSODAT(F,PSOIENS,2.3,"I"))
.D RRDELTA^PSOERXU2(.DELTAS,REQIEN,PSOIEN)
.I $O(PSOEXMS(0)),RESTYPE="AWC",$D(DELTAS(52.49,"EXTERNAL PROVIDER")) D Q
..D MSGDIR^PSOERXU1(.PSOEXMS)
.I $O(PSOEXMS(0)),$E(RESTYPE)="A",'$D(DELTAS(52.49,"EXTERNAL PROVIDER")) D Q
..D UPDSTAT^PSOERXU1(PSOIEN,"RXF","Unable to add order to Pending file.") Q
.I $D(DELTAS(52.49,"EXTERNAL PROVIDER")) D ADD Q
.; call using silent mode if this is auto-processing
.D ADD($S($G(PSOCLNC):0,1:1))
S ERXSTA=$G(PSODAT(F,PSOIENS,1,"E")) I ERXSTA="E"!($E(ERXSTA)="H") S PSOEXCNT=PSOEXCNT+1,PSOEXMS(PSOEXCNT)="eRx is in a 'Hold' status." D MSGDIR^PSOERXU1(.PSOEXMS) Q
I MTYPE="N"!(MTYPE="RE"&(RESTYPE="R")!(MTYPE="CX")) D
.S PMVAL=$G(PSODAT(F,PSOIENS,1.7,"I")) I 'PMVAL S PSOEXCNT=PSOEXCNT+1,PSOEXMS(PSOEXCNT)="Patient has not been manually validated."
.S PRMVAL=$G(PSODAT(F,PSOIENS,1.3,"I")) I 'PRMVAL S PSOEXCNT=PSOEXCNT+1,PSOEXMS(PSOEXCNT)="Provider has not been manually validated."
.S DMVAL=$G(PSODAT(F,PSOIENS,1.5,"I")) I 'DMVAL S PSOEXCNT=PSOEXCNT+1,PSOEXMS(PSOEXCNT)="Drug has not been manually validated."
; for now, if validations have not occurred, do not check the other fields.
I $O(PSOEXMS(0)) D MSGDIR^PSOERXU1(.PSOEXMS) Q
; CS eRx Validations
D PRDRVAL^PSOERXUT(.CSERRMSG,"AC",PSOIEN)
I '$G(CSERRMSG),$P(CSERRMSG,"^",2)="B" D MSGDIR^PSOERXU1(.CSERRMSG) Q
I $$GET1^DIQ(52.49,PSOIEN,95.1,"I"),'$$VALPTADD^PSOERXUT(+$G(PSODAT(F,PSOIENS,.05,"I"))) D Q
. S CSERRMSG(1)="Patient does not have a current mailing or residential address on file."
. D MSGDIR^PSOERXU1(.CSERRMSG)
;
S POORD=$G(PSODAT(F,PSOIENS,25.2,"I")) I POORD S PSOEXCNT=PSOEXCNT+1,PSOEXMS(PSOEXCNT)="Pending outpatient order already exists."
S PATIEN=$G(PSODAT(F,PSOIENS,.05,"I")) I 'PATIEN S PSOEXCNT=PSOEXCNT+1,PSOEXMS(PSOEXCNT)="No matched vista patient."
S PROVIEN=$G(PSODAT(F,PSOIENS,2.3,"I")) I 'PROVIEN S PSOEXCNT=PSOEXCNT+1,PSOEXMS(PSOEXCNT)="Provider not matched to a vista provider."
S VADRUG=$G(PSODAT(F,PSOIENS,3.2,"I")) I 'VADRUG S PSOEXCNT=PSOEXCNT+1,PSOEXMS(PSOEXCNT)="Drug not matched to a vista drug."
S ERXNUM=$G(PSODAT(F,PSOIENS,.01,"E")) I 'ERXNUM S PSOEXCNT=PSOEXCNT+1,PSOEXMS(PSOEXCNT)="eRx number missing."
S VQTY=$G(PSODAT(F,PSOIENS,20.1,"E")) I 'VQTY S PSOEXCNT=PSOEXCNT+1,PSOEXMS(PSOEXCNT)="Quantity missing."
S EFFDT=$G(PSODAT(F,PSOIENS,6.3,"I")),WRITDT=$G(PSODAT(F,PSOIENS,5.9,"I"))
S LOC=$G(PSODAT(F,PSOIENS,20.6,"I")) I 'LOC S LOC=$$GET1^DIQ(59,PSOSITE,10,"I")
; if the effective date is passed in and there is no time, add .000001 to the date
I EFFDT]"" S EFFDT=$P(EFFDT,".")
I '$L(EFFDT) S EFFDT=WRITDT
S VADAYS=$G(PSODAT(F,PSOIENS,20.2,"E"))
S VAOI=$$GET1^DIQ(50,VADRUG,2.1,"I") I 'VAOI S PSOEXCNT=PSOEXCNT+1,PSOEXMS(PSOEXCNT)="Orderable item not associated with drug."
S VAREF=$G(PSODAT(F,PSOIENS,20.5,"E"))
S VAROUT=$G(PSODAT(F,PSOIENS,20.4,"I")) I '$L(VAROUT) S PSOEXCNT=PSOEXCNT+1,PSOEXMS(PSOEXCNT)="Pickup routing missing."
S PATINST=$G(PSODAT(F,PSOIENS,27,"E"))
; CALL TO AVOID SPACE CONCATENATION
D TXT2ARY^PSOERXD1(.PINARY,$$LSIG^PSOERXU6(PATINST))
; get provider comments from VA PROVIDER COMMENTS field
S PRVCOMM=$G(PSODAT(F,PSOIENS,30,"E"))
D TXT2ARY^PSOERXD1(.PRVARY,$$LSIG^PSOERXU6(PRVCOMM))
S (PLOOP,PCNT)=0 F S PLOOP=$O(PRVARY(PLOOP)) Q:'PLOOP D
.S PCNT=PCNT+1,PSOHY("PRCOM",PCNT)=$G(PRVARY(PLOOP))
I '$O(^PS(52.49,PSOIEN,21,0)) S PSOEXCNT=PSOEXCNT+1,PSOEXMS(PSOEXCNT)="Dosing information missing."
S (QTLOOP,QTCNT)=0 F S QTLOOP=$O(^PS(52.49,PSOIEN,21,QTLOOP)) Q:'QTLOOP D
.S QTCNT=QTCNT+1 M PSOHY("QTSUB",QTCNT)=^PS(52.49,PSOIEN,21,QTLOOP)
;
; Assigning Clinic which the User is logged into
S (LOC,PSOQUIT)=0
I $G(MBMSITE),DUZ'=+$$PROXYDUZ^PSOERXUT(),+$$GET1^DIQ(52.49,PSOIEN,20.6,"I")'=+$G(PSOCLNC) D I $G(PSOQUIT) S DIR(0)="E" D ^DIR K DIR Q
. W !!,"Current Clinic assigned to the eRx: ",$$GET1^DIQ(52.49,PSOIEN,20.6),!
. K DIC S DIC(0)="AEMQ",DIC=44,DIC("S")="I '$P($G(^(""I"")),U,1)!$P($G(^(""I"")),U,2)"
. S DIC("A")="Send to eRx Clinic: "
. I $G(PSOCLNC) S DIC("B")=$$GET1^DIQ(44,PSOCLNC,.01)
. D ^DIC I Y="^"!$D(DTOUT)!$D(DUOUT) S PSOQUIT=1 Q
. I $G(Y)>0 S LOC=+Y
; always 'routine' for now
S VAPRIOR="R"
; always 'new' for this version
I '$L($G(ORDERTYP)) S ORDERTYP="NW"
I $G(LOC) S PSOHY("LOC")=LOC
I '$G(PSOHY("LOC")) D
. I $G(PSOCLNC) D
. . S PSOHY("LOC")=PSOCLNC
. E S PSOHY("LOC")=+$$GET1^DIQ(59,+$G(PSOSITE),10,"I")
S PSOHY("CHNUM")=$G(ERXNUM)
S PSOHY("PICK")=VAROUT
S PSOHY("ENTER")=DUZ
S PSOHY("PROV")=PROVIEN,PSOHY("SDT")=EFFDT
S PSOHY("ITEM")=VAOI,PSOHY("DRUG")=VADRUG
S PSOHY("QTY")=VQTY,PSOHY("REF")=VAREF
S (PSOHY("PAT"),DFN)=PATIEN,PSOHY("OCC")=ORDERTYP
; Login date will always be the Message Received Date/Time
S PSOHY("EDT")=$$GET1^DIQ(52.49,PSOIEN,.03,"I"),PSOHY("PRIOR")=VAPRIOR
; ALWAYS PSO as the external application
S PSOHY("EXAPP")="PHARMACY"
S PSOHY("DAYS")=VADAYS
; sig from eRx
S (SLOOP,SCNT)=0 F S SLOOP=$O(^PS(52.49,PSOIEN,"SIG",SLOOP)) Q:'SLOOP D
.S SIGDAT=$G(^PS(52.49,PSOIEN,"SIG",SLOOP,0))
.S SCNT=SCNT+1,PSOHY("SIG",SCNT)=SIGDAT
;indications for use from erx, concatenate it to the sig if set to 1
S (PAINDFU,PSOHY("IND"))=$G(PSODAT(F,PSOIENS,29,"E")) ;patient indications for use
S PSOHY("INDO")=$G(PSODAT(F,PSOIENS,29.2,"E"))
D TXT2ARY^PSOERXD1(.INDARY,$$LSIG^PSOERXU6(PAINDFU)) ;patient indications for use
I +$G(PSODAT(F,PSOIENS,29.1,"I")) D
. S SLOOP3=0 F S SLOOP3=$O(INDARY(SLOOP3)) Q:'SLOOP3 D
. . S SCNT=SCNT+1,PSOHY("SIG",SCNT)=$G(INDARY(SLOOP3))
;patient instructions
S SLOOP2=0 F S SLOOP2=$O(PINARY(SLOOP2)) Q:'SLOOP2 D
.S SCNT=SCNT+1,PSOHY("SIG",SCNT)=$G(PINARY(SLOOP2))
; if provider, patient or drug is missing, no need to continue.
D ADD
I $G(PSOEXMS)]"" W !,PSOEXMS S DIR(0)="E" D ^DIR K DIR Q
D REF^PSOERSE1
K DFN
Q
ADD(QUIET) ;Add CHCS message to Outpatient Pending Orders file
N MBMSITE,PSOHQ,PSOHQT,PSOCPEND,PSOHINI,PSOHINLO,ERXSTA,ORDNUM,ILOOP,IARY,PSSRET,DA,PSORDEA,PSORDFDA,PSORDNUM
S MBMSITE=$S($$GET1^DIQ(59.7,1,102,"I")="MBM":1,1:0)
I '$G(PSOHY("DRUG")) D Q
. S PSOEXCNT=PSOEXCNT+1,PSOEXMS(PSOEXCNT)="Invalid Dispense Drug" Q
S (PSOHINI,PSOHINLO)=0 D
. I $G(PSOHY("LOC")) S PSOHINLO=$P($G(^SC(PSOHY("LOC"),0)),"^",4)
; get institution from 52.49 if clinic was not passed in
S RESTYPE=$$GET1^DIQ(52.49,PSOIEN,52.1,"I")
I $G(PSOHINLO)<1 S PSOHINLO=$$GET1^DIQ(52.49,PSOIEN,24.1,"I")
I +$G(PSOHINLO)<1 S PSOEXCNT=PSOEXCNT+1,PSOEXMS(PSOEXCNT)="Unable to derive Institution from Clinic." Q
K DD,DO,DIC S X=PSOHY("CHNUM"),DIC="^PS(52.41,",DIC(0)="L"
S:$G(PSOHY("PICK"))="" PSOHY("PICK")="M"
S DIC("DR")="4////"_$G(PSOHY("ENTER"))_";5////"_PSOHY("PROV")_";6////"_$G(PSOHY("SDT"))_";8////"_PSOHY("ITEM")_";11////"_PSOHY("DRUG")
S DIC("DR")=$G(DIC("DR"))_";12////"_$G(PSOHY("QTY"))_";13////"_$G(PSOHY("REF"))_";22.1////"_$G(PSOHY("PREVORD"))_";101////"_$G(PSOHY("DAYS"))
D FILE^DICN K DD,DIC,DO I Y<0 D Q
.S PSOEXCNT=PSOEXCNT+1,PSOEXMS(PSOEXCNT)="Unable to add order to Pending file."
.I MTYPE="RE" D UPDSTAT^PSOERXU1(PSOIEN,"RXF",PSOEXMS(PSOEXCNT))
.S REQIEN=$$GETREQ^PSOERXU2(PSOIEN) I REQIEN D UPDSTAT^PSOERXU1(PSOIEN,"RRF",PSOEXMS)
S PSOCPEND=+Y
S $P(^PS(52.41,PSOCPEND,0),"^",2)=PSOHY("PAT"),$P(^(0),"^",3)=PSOHY("OCC"),$P(^(0),"^",12)=$G(PSOHY("EDT")),$P(^(0),"^",13)=$G(PSOHY("LOC"))
S $P(^PS(52.41,PSOCPEND,0),"^",14)=$G(PSOHY("PRIOR")),$P(^(0),"^",17)=$G(PSOHY("PICK"))
S $P(^PS(52.41,PSOCPEND,"EXT"),"^")=PSOHY("CHNUM"),$P(^("EXT"),"^",2)=0,$P(^("EXT"),"^",3)=PSOHY("EXAPP")
S DIE="^PS(52.41,",DA=PSOCPEND,DR="104.1///1" D ^DIE K DIE,DA,DR
; PSO*7*506
S FDA(52.41,PSOCPEND_",",104)=$G(PATINST) D FILE^DIE(,"FDA") K FDA
N DA,DIK S DA=PSOCPEND,DIK="^PS(52.41,",DIK(1)="114^C" D EN1^DIK
I $O(PSOHY("PRCOM",0)) D I PSOHQT S ^PS(52.41,PSOCPEND,3,0)="^^"_PSOHQT_"^"_PSOHQT_"^"_DT_"^"
.S PSOHQ="",PSOHQT=0 F S PSOHQ=$O(PSOHY("PRCOM",PSOHQ)) Q:PSOHQ="" I $G(PSOHY("PRCOM",PSOHQ))'="" S PSOHQT=PSOHQT+1,^PS(52.41,PSOCPEND,3,PSOHQT,0)=$G(PSOHY("PRCOM",PSOHQ))
S $P(^PS(52.41,PSOCPEND,4),"^",2,3)=$G(PSOHY("IND"))_"^"_$G(PSOHY("INDO")) ;indication for use and other language indication for use
I $O(PSOHY("SIG",0)) D I PSOHQT S ^PS(52.41,PSOCPEND,"SIG",0)="^52.4124A^"_PSOHQT_"^"_PSOHQT
.S PSOHQ="",PSOHQT=0 F S PSOHQ=$O(PSOHY("SIG",PSOHQ)) Q:PSOHQ="" I $G(PSOHY("SIG",PSOHQ))'="" S PSOHQT=PSOHQT+1,^PS(52.41,PSOCPEND,"SIG",PSOHQT,0)=$G(PSOHY("SIG",PSOHQ))
S $P(^PS(52.41,PSOCPEND,"INI"),"^")=$G(PSOHINLO)
; add quantity/timing subfile information
I $O(PSOHY("QTSUB",0)) D I PSOHQT S ^PS(52.41,PSOCPEND,1,0)="^52.413^"_PSOHQT_"^"_PSOHQT
.S PSOHQ="",PSOHQT=0 F S PSOHQ=$O(PSOHY("QTSUB",PSOHQ)) Q:PSOHQ="" D
..I $O(PSOHY("QTSUB",PSOHQ,0)) S PSOHQT=PSOHQT+1
..S ^PS(52.41,PSOCPEND,1,PSOHQT,0)=PSOHY("QTSUB",PSOHQ,0)
..S ^PS(52.41,PSOCPEND,1,PSOHQT,1)=PSOHY("QTSUB",PSOHQ,1)
..S ^PS(52.41,PSOCPEND,1,PSOHQT,2)=PSOHY("QTSUB",PSOHQ,2)
I $O(PINARY(0)) D WP^DIE(52.41,PSOCPEND_",",105,"K","PINARY")
;Cross references not set yet preventing Pharmacy from finishing order
D EN^PSOHLSNC(PSOCPEND,"SN","IP")
D FULL^VALM1
S PSORDNUM=$P($G(^PS(52.41,PSOCPEND,0)),U)
S PSORDEA=$$FIND1^DIC(101.52,"","B",PSORDNUM)
I $E($$GET1^DIQ(101.52,PSORDEA,1,"I"),*)'="S" S PSORDEA=""
I PSORDEA S PSORDFDA(101.52,PSORDEA_",",1)="@" D FILE^DIE("K","PSORDFDA")
;
;Just set to DC, don't delete because 52.41 entry would be re-used
I '$P($G(^PS(52.41,PSOCPEND,"EXT")),"^",2) D S $P(^PS(52.41,PSOCPEND,0),"^",3)="DC" S PSOEXCNT=PSOEXCNT+1,PSOEXMS(PSOEXCNT)="Unable to send CHCS order to CPRS." Q
.;x-ref shouldn't be set, but we'll kill them just in case
.K ^PS(52.41,"AOR",$P(^PS(52.41,PSOCPEND,0),"^",2),+$P($G(^("INI")),"^"),PSOCPEND),^PS(52.41,"AD",$P(^PS(52.41,PSOCPEND,0),"^",12),+$P($G(^("INI")),"^"),PSOCPEND)
.K ^PS(52.41,"ACL",+$P(^PS(52.41,PSOCPEND,0),"^",13),$P(^(0),"^",12),PSOCPEND),^PS(52.41,"AQ",+$P($G(^PS(52.41,PSOCPEND,0)),"^",21),PSOCPEND)
.S $P(^PS(52.41,PSOCPEND,4),"^")="External order, unable to successfully transmit to CPRS."
.I $D(QUIET) S PSOEXCNT=PSOEXCNT+1,PSOEXMS(PSOEXCNT)="External order, unable to successfully transmit to CPRS."
.I '$D(QUIET) W !!,"External order, unable to successfully transmit to CPRS."
.I '$D(QUIET) S DIR(0)="E" D ^DIR
;Successful transmission to CPRS
S DA=PSOCPEND,DIK="^PS(52.41," D IX^DIK
; add the pending outpatient order number to 52.49 and update status of eRx to PR (Processed)
S ERXSTA=$O(^PS(52.45,"C","ERX","PR",0))
S ORDNUM=$P($G(^PS(52.41,PSOCPEND,0)),U)
S DIE="^PS(52.49,",DR="25.2///"_PSOCPEND_";.12///"_ORDNUM,DA=PSOIEN D ^DIE K DIE,DA,DR
; PSO*7*508 - add checks to update refill requests and responses
; add activity to status history
I MTYPE="N" D UPDSTAT^PSOERXU1(PSOIEN,"PR")
I MTYPE="RE" D UPDSTAT^PSOERXU1(PSOIEN,"RXP")
;B3S4
I MTYPE="CX" D
.D UPDSTAT^PSOERXU1(PSOIEN,"CXP")
.S RTHID=$$GET1^DIQ(52.49,PSOIEN,.14),RTHIEN=$O(^PS(52.49,"FMID",RTHID,0))
.D UPDSTAT^PSOERXU1(RTHIEN,"CRP")
S REQIEN=$$GETREQ^PSOERXU2(PSOIEN) I REQIEN,$$GET1^DIQ(52.49,REQIEN,.08,"I")="RR" D UPDSTAT^PSOERXU1(REQIEN,"RRP")
; PSO*7*508 - end
;
; Saves the Actual eRx SIG (from outside provider) into the PROVIDER COMMENTS field (P-651/14)
N UNEXINS S UNEXINS(1)=$$ERXSIG^PSOERXUT(PSOIEN)
I $L($G(UNEXINS(1))) D WP^DIE(52.41,PSOCPEND_",",9,"K","UNEXINS")
;
I '$D(QUIET) D
. W !!,"eRx #"_PSOHY("CHNUM")_" sent to PENDING ORDERS Queue."
. W:$G(MBMSITE) " (Clinic: "_$$GET1^DIQ(44,+$G(PSOHY("LOC")),.01)_")" H 1.5
;PSO*7*520 - add sending and warning/information related to RxVerify Message.
I '$$UNACCBEF^PSOERX1H(PSOIEN),MTYPE="N"!((MTYPE="RE")&(RESTYPE="R"))!(MTYPE="CX") D
. W !!,"Sending rxVerify Message to prescriber."
. D POST^PSOERXO1(PSOIEN,.PSSRET,,,,1)
. ; if the post was unsuccessful, inform the user and quit.
. I $P(PSSRET(0),U)<1 W !,$P(PSSRET(0),U,2) S DIR(0)="E" D ^DIR K DIR Q
. I $D(PSSRET("errorMessage")) W !,PSSRET("errorMessage") S DIR(0)="E" D ^DIR K DIR Q
. S DIR(0)="E" D ^DIR K DIR
;PSO*7*520 - end rxVerify changes
;
K QUIET
Q
;
ORDNUM() ; Returns the correct IEN for the ORDER file (#100) for the Rx
I $P(XQY0,"^")="PSO LM BACKDOOR ORDERS"!($P(XQY0,"^")="PSO LMOE FINISH"),$P(VALMKEY,"^",2)="PSO HIDDEN ACTIONS",$G(RXN) Q +$$GET1^DIQ(52,RXN,39.3,"I")
I $P(XQY0,"^")="PSO LM BACKDOOR ORDERS"!($P(XQY0,"^")="PSO LMOE FINISH")!($P(XQY0,"^")="PSO PMP"),$P(VALMKEY,"^",2)="PSO HIDDEN ACTIONS #3"!($P(VALMKEY,"^",2)="PSO HIDDEN ACTIONS #4"),$G(ORD) Q +$$GET1^DIQ(52.41,+ORD,.01)
I $P(XQY0,"^")="PSO VIEW"!($P(XQY0,"^")="PSO PMP"),$P(VALMKEY,"^",2)="PSO PMP HIDDEN ACTIONS MENU #2",$G(RXN) Q +$$GET1^DIQ(52,RXN,39.3,"I")
Q 0
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSOERX1F 15378 printed Aug 26, 2025@22:44:21 Page 2
PSOERX1F ;ALB/MR - Accept/Un-Accept eRx function ; 8/18/2020 5:14pm
+1 ;;7.0;OUTPATIENT PHARMACY;**617,651,700,746,770**;DEC 1997;Build 145
+2 ;
+3 QUIT
+4 ;PSOHY("LOC")=IEN of hospital location file (#44) - NOT USED,
+5 ;PSOHY("CHNUM")=EXTERNAL PLACER ORDER NUMBER (NEED TO FIND OUT HOW WE SHOULD SET THIS) (25)
+6 ;PSOHY("PICK")=MAIL/WINDOW (20.4)
+7 ;PSOHY("ENTER")=ENTERED BY IEN (2.1)
+8 ;PSOHY("PROV")=PROVIDER IEN (2.3)
+9 ;PSOHY("SDT")=EFFECTIVE DATE (6.3)
+10 ;PSOHY("ITEM")=PHARMACY ORDERABLE ITEM (DERIVED FROM THE DRUG IEN) - NO MAPPING TO 52.49
+11 ;PSOHY("DRUG")=DRUG IEN (3.2)
+12 ;PSOHY("QTY")=QUANTITY (20.1)
+13 ;PSOHY("REF")=# OF REFILLS (20.5)
+14 ;PSOHY("PAT")=PATIENT IEN (.05)
+15 ;PSOHY("OCC")=ORDER TYPE (ALWAYS 'NW') - NO MAPPING TO 52.49
+16 ;PSOHY("EDT")=LOGIN DATE/TIME (ERX MSG DATE/TIME #.03)
+17 ;PSOHY("PRIOR")=PRIORITY (SET OF CODES, 52.41,25 - STAT, EMERGENCY, ROUTINE)
+18 ;PSOHY("EXAPP")=EXTERNAL APPLICATION (FREE TEXT), LIKELY "PSO" - NO MAPPING TO 52.49
+19 ;PSOHY("PRCOM",#)=PROVIDER COMMENTS (8- NOTES)
+20 ;PSOHY("SIG",#)=SIG (52.4911 (STRUCTURED SIG), FIELD 1 (SIG FREE TEXT)
+21 ;PSOHY("QTSUB",CNT)=QUANTITY TIMING SUBFILE DATA. MERGED IN, FULL SUBFILE DATA
+22 ;PSOHY("IND")=INDICATION FOR USE (29)
+23 ;PSOHY("INDO")=OTHER LANG INDICATION FOR USE (29.2)
+24 ; QUANTITY/TIMING MAPS DIRECTLY TO QUANTITY TIMING IN 52.41
SETUP ;
+1 NEW MBMSITE,PSOIENS,PSODAT,F,PATIEN,PROVIEN,OC,VQTY,EFFDT,VADRUG,VAOI,VAREF,VAROUT,VAPRIOR,PSOHY,LOC,ERXNUM,PRVARY,PRVCOMM
+2 NEW PLOOP,PCNT,QTLOOP,QTCNT,PSOEXMS,DIR,ORDERTYP,PSOEXCNT,SCNT,SIGDAT,SLOOP,POORD,PMVAL,PRMVAL,DMVAL,PATINST,RXSTAT
+3 NEW VADAYS,UNEXPI,PINARY,WRITDT,SLOOP2,MTYPE,REQIEN,ORXIEN,RESTYPE,DELTAS,RXIEN,ERXMSG,I,CSERRMSG,PSOQUIT,DIC,PAINDFU,INDARY,SLOOP3
+4 SET MBMSITE=$SELECT($$GET1^DIQ(59.7,1,102,"I")="MBM":1,1:0)
+5 SET F=52.49
+6 if '$GET(PSOIEN)
QUIT
+7 DO FULL^VALM1
IF MBMSITE
SET VALMBCK="R"
+8 IF $$DONOTFIL^PSOERXUT(PSOIEN)
QUIT
+9 SET RXSTAT=$$GET1^DIQ(52.49,PSOIEN,1,"E")
+10 IF RXSTAT="RJ"!(RXSTAT="RM")!($EXTRACT(RXSTAT,1,3)="REM")!(RXSTAT="PR")!(RXSTAT="CXP")!(RXSTAT="RXP")
Begin DoDot:1
+11 WRITE !!,"Cannot accept a prescription with a status of 'Rejected', 'Removed',",!,"or 'Processed",!
+12 SET DIR(0)="E"
DO ^DIR
End DoDot:1
QUIT
+13 SET PSOIENS=PSOIEN_","
+14 DO GETS^DIQ(F,PSOIENS,".01;.05;.07;.08;1;1.3;1.5;1.7;2.1;2.3;3.2;5.9;6.2;6.3;8;20.1;20.2;20.4;20.5;20.6;25;25.2;27;29;29.1;29.2;30;52.1","IE","PSODAT")
+15 SET PSOEXCNT=0
+16 SET MTYPE=$GET(PSODAT(F,PSOIENS,.08,"I"))
+17 SET RESTYPE=$GET(PSODAT(F,PSOIENS,52.1,"I"))
+18 IF MTYPE="RE"
IF RESTYPE'="R"
Begin DoDot:1
+19 SET REQIEN=$$GETREQ^PSOERXU2(PSOIEN)
+20 IF REQIEN
SET RXIEN=$$GET1^DIQ(52.49,REQIEN,.13,"I")
+21 DO PREFRES^PSOERXU3(PSOIEN,.PSOHY,.PSOEXCNT,.PSOEXMS,.PSODAT)
+22 IF $GET(PSODAT(F,PSOIENS,2.3,"I"))
SET PSOHY("PROV")=$GET(PSODAT(F,PSOIENS,2.3,"I"))
+23 DO RRDELTA^PSOERXU2(.DELTAS,REQIEN,PSOIEN)
+24 IF $ORDER(PSOEXMS(0))
IF RESTYPE="AWC"
IF $DATA(DELTAS(52.49,"EXTERNAL PROVIDER"))
Begin DoDot:2
+25 DO MSGDIR^PSOERXU1(.PSOEXMS)
End DoDot:2
QUIT
+26 IF $ORDER(PSOEXMS(0))
IF $EXTRACT(RESTYPE)="A"
IF '$DATA(DELTAS(52.49,"EXTERNAL PROVIDER"))
Begin DoDot:2
+27 DO UPDSTAT^PSOERXU1(PSOIEN,"RXF","Unable to add order to Pending file.")
QUIT
End DoDot:2
QUIT
+28 IF $DATA(DELTAS(52.49,"EXTERNAL PROVIDER"))
DO ADD
QUIT
+29 ; call using silent mode if this is auto-processing
+30 DO ADD($SELECT($GET(PSOCLNC):0,1:1))
End DoDot:1
QUIT
+31 SET ERXSTA=$GET(PSODAT(F,PSOIENS,1,"E"))
IF ERXSTA="E"!($EXTRACT(ERXSTA)="H")
SET PSOEXCNT=PSOEXCNT+1
SET PSOEXMS(PSOEXCNT)="eRx is in a 'Hold' status."
DO MSGDIR^PSOERXU1(.PSOEXMS)
QUIT
+32 IF MTYPE="N"!(MTYPE="RE"&(RESTYPE="R")!(MTYPE="CX"))
Begin DoDot:1
+33 SET PMVAL=$GET(PSODAT(F,PSOIENS,1.7,"I"))
IF 'PMVAL
SET PSOEXCNT=PSOEXCNT+1
SET PSOEXMS(PSOEXCNT)="Patient has not been manually validated."
+34 SET PRMVAL=$GET(PSODAT(F,PSOIENS,1.3,"I"))
IF 'PRMVAL
SET PSOEXCNT=PSOEXCNT+1
SET PSOEXMS(PSOEXCNT)="Provider has not been manually validated."
+35 SET DMVAL=$GET(PSODAT(F,PSOIENS,1.5,"I"))
IF 'DMVAL
SET PSOEXCNT=PSOEXCNT+1
SET PSOEXMS(PSOEXCNT)="Drug has not been manually validated."
End DoDot:1
+36 ; for now, if validations have not occurred, do not check the other fields.
+37 IF $ORDER(PSOEXMS(0))
DO MSGDIR^PSOERXU1(.PSOEXMS)
QUIT
+38 ; CS eRx Validations
+39 DO PRDRVAL^PSOERXUT(.CSERRMSG,"AC",PSOIEN)
+40 IF '$GET(CSERRMSG)
IF $PIECE(CSERRMSG,"^",2)="B"
DO MSGDIR^PSOERXU1(.CSERRMSG)
QUIT
+41 IF $$GET1^DIQ(52.49,PSOIEN,95.1,"I")
IF '$$VALPTADD^PSOERXUT(+$GET(PSODAT(F,PSOIENS,.05,"I")))
Begin DoDot:1
+42 SET CSERRMSG(1)="Patient does not have a current mailing or residential address on file."
+43 DO MSGDIR^PSOERXU1(.CSERRMSG)
End DoDot:1
QUIT
+44 ;
+45 SET POORD=$GET(PSODAT(F,PSOIENS,25.2,"I"))
IF POORD
SET PSOEXCNT=PSOEXCNT+1
SET PSOEXMS(PSOEXCNT)="Pending outpatient order already exists."
+46 SET PATIEN=$GET(PSODAT(F,PSOIENS,.05,"I"))
IF 'PATIEN
SET PSOEXCNT=PSOEXCNT+1
SET PSOEXMS(PSOEXCNT)="No matched vista patient."
+47 SET PROVIEN=$GET(PSODAT(F,PSOIENS,2.3,"I"))
IF 'PROVIEN
SET PSOEXCNT=PSOEXCNT+1
SET PSOEXMS(PSOEXCNT)="Provider not matched to a vista provider."
+48 SET VADRUG=$GET(PSODAT(F,PSOIENS,3.2,"I"))
IF 'VADRUG
SET PSOEXCNT=PSOEXCNT+1
SET PSOEXMS(PSOEXCNT)="Drug not matched to a vista drug."
+49 SET ERXNUM=$GET(PSODAT(F,PSOIENS,.01,"E"))
IF 'ERXNUM
SET PSOEXCNT=PSOEXCNT+1
SET PSOEXMS(PSOEXCNT)="eRx number missing."
+50 SET VQTY=$GET(PSODAT(F,PSOIENS,20.1,"E"))
IF 'VQTY
SET PSOEXCNT=PSOEXCNT+1
SET PSOEXMS(PSOEXCNT)="Quantity missing."
+51 SET EFFDT=$GET(PSODAT(F,PSOIENS,6.3,"I"))
SET WRITDT=$GET(PSODAT(F,PSOIENS,5.9,"I"))
+52 SET LOC=$GET(PSODAT(F,PSOIENS,20.6,"I"))
IF 'LOC
SET LOC=$$GET1^DIQ(59,PSOSITE,10,"I")
+53 ; if the effective date is passed in and there is no time, add .000001 to the date
+54 IF EFFDT]""
SET EFFDT=$PIECE(EFFDT,".")
+55 IF '$LENGTH(EFFDT)
SET EFFDT=WRITDT
+56 SET VADAYS=$GET(PSODAT(F,PSOIENS,20.2,"E"))
+57 SET VAOI=$$GET1^DIQ(50,VADRUG,2.1,"I")
IF 'VAOI
SET PSOEXCNT=PSOEXCNT+1
SET PSOEXMS(PSOEXCNT)="Orderable item not associated with drug."
+58 SET VAREF=$GET(PSODAT(F,PSOIENS,20.5,"E"))
+59 SET VAROUT=$GET(PSODAT(F,PSOIENS,20.4,"I"))
IF '$LENGTH(VAROUT)
SET PSOEXCNT=PSOEXCNT+1
SET PSOEXMS(PSOEXCNT)="Pickup routing missing."
+60 SET PATINST=$GET(PSODAT(F,PSOIENS,27,"E"))
+61 ; CALL TO AVOID SPACE CONCATENATION
+62 DO TXT2ARY^PSOERXD1(.PINARY,$$LSIG^PSOERXU6(PATINST))
+63 ; get provider comments from VA PROVIDER COMMENTS field
+64 SET PRVCOMM=$GET(PSODAT(F,PSOIENS,30,"E"))
+65 DO TXT2ARY^PSOERXD1(.PRVARY,$$LSIG^PSOERXU6(PRVCOMM))
+66 SET (PLOOP,PCNT)=0
FOR
SET PLOOP=$ORDER(PRVARY(PLOOP))
if 'PLOOP
QUIT
Begin DoDot:1
+67 SET PCNT=PCNT+1
SET PSOHY("PRCOM",PCNT)=$GET(PRVARY(PLOOP))
End DoDot:1
+68 IF '$ORDER(^PS(52.49,PSOIEN,21,0))
SET PSOEXCNT=PSOEXCNT+1
SET PSOEXMS(PSOEXCNT)="Dosing information missing."
+69 SET (QTLOOP,QTCNT)=0
FOR
SET QTLOOP=$ORDER(^PS(52.49,PSOIEN,21,QTLOOP))
if 'QTLOOP
QUIT
Begin DoDot:1
+70 SET QTCNT=QTCNT+1
MERGE PSOHY("QTSUB",QTCNT)=^PS(52.49,PSOIEN,21,QTLOOP)
End DoDot:1
+71 ;
+72 ; Assigning Clinic which the User is logged into
+73 SET (LOC,PSOQUIT)=0
+74 IF $GET(MBMSITE)
IF DUZ'=+$$PROXYDUZ^PSOERXUT()
IF +$$GET1^DIQ(52.49,PSOIEN,20.6,"I")'=+$GET(PSOCLNC)
Begin DoDot:1
+75 WRITE !!,"Current Clinic assigned to the eRx: ",$$GET1^DIQ(52.49,PSOIEN,20.6),!
+76 KILL DIC
SET DIC(0)="AEMQ"
SET DIC=44
SET DIC("S")="I '$P($G(^(""I"")),U,1)!$P($G(^(""I"")),U,2)"
+77 SET DIC("A")="Send to eRx Clinic: "
+78 IF $GET(PSOCLNC)
SET DIC("B")=$$GET1^DIQ(44,PSOCLNC,.01)
+79 DO ^DIC
IF Y="^"!$DATA(DTOUT)!$DATA(DUOUT)
SET PSOQUIT=1
QUIT
+80 IF $GET(Y)>0
SET LOC=+Y
End DoDot:1
IF $GET(PSOQUIT)
SET DIR(0)="E"
DO ^DIR
KILL DIR
QUIT
+81 ; always 'routine' for now
+82 SET VAPRIOR="R"
+83 ; always 'new' for this version
+84 IF '$LENGTH($GET(ORDERTYP))
SET ORDERTYP="NW"
+85 IF $GET(LOC)
SET PSOHY("LOC")=LOC
+86 IF '$GET(PSOHY("LOC"))
Begin DoDot:1
+87 IF $GET(PSOCLNC)
Begin DoDot:2
+88 SET PSOHY("LOC")=PSOCLNC
End DoDot:2
+89 IF '$TEST
SET PSOHY("LOC")=+$$GET1^DIQ(59,+$GET(PSOSITE),10,"I")
End DoDot:1
+90 SET PSOHY("CHNUM")=$GET(ERXNUM)
+91 SET PSOHY("PICK")=VAROUT
+92 SET PSOHY("ENTER")=DUZ
+93 SET PSOHY("PROV")=PROVIEN
SET PSOHY("SDT")=EFFDT
+94 SET PSOHY("ITEM")=VAOI
SET PSOHY("DRUG")=VADRUG
+95 SET PSOHY("QTY")=VQTY
SET PSOHY("REF")=VAREF
+96 SET (PSOHY("PAT"),DFN)=PATIEN
SET PSOHY("OCC")=ORDERTYP
+97 ; Login date will always be the Message Received Date/Time
+98 SET PSOHY("EDT")=$$GET1^DIQ(52.49,PSOIEN,.03,"I")
SET PSOHY("PRIOR")=VAPRIOR
+99 ; ALWAYS PSO as the external application
+100 SET PSOHY("EXAPP")="PHARMACY"
+101 SET PSOHY("DAYS")=VADAYS
+102 ; sig from eRx
+103 SET (SLOOP,SCNT)=0
FOR
SET SLOOP=$ORDER(^PS(52.49,PSOIEN,"SIG",SLOOP))
if 'SLOOP
QUIT
Begin DoDot:1
+104 SET SIGDAT=$GET(^PS(52.49,PSOIEN,"SIG",SLOOP,0))
+105 SET SCNT=SCNT+1
SET PSOHY("SIG",SCNT)=SIGDAT
End DoDot:1
+106 ;indications for use from erx, concatenate it to the sig if set to 1
+107 ;patient indications for use
SET (PAINDFU,PSOHY("IND"))=$GET(PSODAT(F,PSOIENS,29,"E"))
+108 SET PSOHY("INDO")=$GET(PSODAT(F,PSOIENS,29.2,"E"))
+109 ;patient indications for use
DO TXT2ARY^PSOERXD1(.INDARY,$$LSIG^PSOERXU6(PAINDFU))
+110 IF +$GET(PSODAT(F,PSOIENS,29.1,"I"))
Begin DoDot:1
+111 SET SLOOP3=0
FOR
SET SLOOP3=$ORDER(INDARY(SLOOP3))
if 'SLOOP3
QUIT
Begin DoDot:2
+112 SET SCNT=SCNT+1
SET PSOHY("SIG",SCNT)=$GET(INDARY(SLOOP3))
End DoDot:2
End DoDot:1
+113 ;patient instructions
+114 SET SLOOP2=0
FOR
SET SLOOP2=$ORDER(PINARY(SLOOP2))
if 'SLOOP2
QUIT
Begin DoDot:1
+115 SET SCNT=SCNT+1
SET PSOHY("SIG",SCNT)=$GET(PINARY(SLOOP2))
End DoDot:1
+116 ; if provider, patient or drug is missing, no need to continue.
+117 DO ADD
+118 IF $GET(PSOEXMS)]""
WRITE !,PSOEXMS
SET DIR(0)="E"
DO ^DIR
KILL DIR
QUIT
+119 DO REF^PSOERSE1
+120 KILL DFN
+121 QUIT
ADD(QUIET) ;Add CHCS message to Outpatient Pending Orders file
+1 NEW MBMSITE,PSOHQ,PSOHQT,PSOCPEND,PSOHINI,PSOHINLO,ERXSTA,ORDNUM,ILOOP,IARY,PSSRET,DA,PSORDEA,PSORDFDA,PSORDNUM
+2 SET MBMSITE=$SELECT($$GET1^DIQ(59.7,1,102,"I")="MBM":1,1:0)
+3 IF '$GET(PSOHY("DRUG"))
Begin DoDot:1
+4 SET PSOEXCNT=PSOEXCNT+1
SET PSOEXMS(PSOEXCNT)="Invalid Dispense Drug"
QUIT
End DoDot:1
QUIT
+5 SET (PSOHINI,PSOHINLO)=0
Begin DoDot:1
+6 IF $GET(PSOHY("LOC"))
SET PSOHINLO=$PIECE($GET(^SC(PSOHY("LOC"),0)),"^",4)
End DoDot:1
+7 ; get institution from 52.49 if clinic was not passed in
+8 SET RESTYPE=$$GET1^DIQ(52.49,PSOIEN,52.1,"I")
+9 IF $GET(PSOHINLO)<1
SET PSOHINLO=$$GET1^DIQ(52.49,PSOIEN,24.1,"I")
+10 IF +$GET(PSOHINLO)<1
SET PSOEXCNT=PSOEXCNT+1
SET PSOEXMS(PSOEXCNT)="Unable to derive Institution from Clinic."
QUIT
+11 KILL DD,DO,DIC
SET X=PSOHY("CHNUM")
SET DIC="^PS(52.41,"
SET DIC(0)="L"
+12 if $GET(PSOHY("PICK"))=""
SET PSOHY("PICK")="M"
+13 SET DIC("DR")="4////"_$GET(PSOHY("ENTER"))_";5////"_PSOHY("PROV")_";6////"_$GET(PSOHY("SDT"))_";8////"_PSOHY("ITEM")_";11////"_PSOHY("DRUG")
+14 SET DIC("DR")=$GET(DIC("DR"))_";12////"_$GET(PSOHY("QTY"))_";13////"_$GET(PSOHY("REF"))_";22.1////"_$GET(PSOHY("PREVORD"))_";101////"_$GET(PSOHY("DAYS"))
+15 DO FILE^DICN
KILL DD,DIC,DO
IF Y<0
Begin DoDot:1
+16 SET PSOEXCNT=PSOEXCNT+1
SET PSOEXMS(PSOEXCNT)="Unable to add order to Pending file."
+17 IF MTYPE="RE"
DO UPDSTAT^PSOERXU1(PSOIEN,"RXF",PSOEXMS(PSOEXCNT))
+18 SET REQIEN=$$GETREQ^PSOERXU2(PSOIEN)
IF REQIEN
DO UPDSTAT^PSOERXU1(PSOIEN,"RRF",PSOEXMS)
End DoDot:1
QUIT
+19 SET PSOCPEND=+Y
+20 SET $PIECE(^PS(52.41,PSOCPEND,0),"^",2)=PSOHY("PAT")
SET $PIECE(^(0),"^",3)=PSOHY("OCC")
SET $PIECE(^(0),"^",12)=$GET(PSOHY("EDT"))
SET $PIECE(^(0),"^",13)=$GET(PSOHY("LOC"))
+21 SET $PIECE(^PS(52.41,PSOCPEND,0),"^",14)=$GET(PSOHY("PRIOR"))
SET $PIECE(^(0),"^",17)=$GET(PSOHY("PICK"))
+22 SET $PIECE(^PS(52.41,PSOCPEND,"EXT"),"^")=PSOHY("CHNUM")
SET $PIECE(^("EXT"),"^",2)=0
SET $PIECE(^("EXT"),"^",3)=PSOHY("EXAPP")
+23 SET DIE="^PS(52.41,"
SET DA=PSOCPEND
SET DR="104.1///1"
DO ^DIE
KILL DIE,DA,DR
+24 ; PSO*7*506
+25 SET FDA(52.41,PSOCPEND_",",104)=$GET(PATINST)
DO FILE^DIE(,"FDA")
KILL FDA
+26 NEW DA,DIK
SET DA=PSOCPEND
SET DIK="^PS(52.41,"
SET DIK(1)="114^C"
DO EN1^DIK
+27 IF $ORDER(PSOHY("PRCOM",0))
Begin DoDot:1
+28 SET PSOHQ=""
SET PSOHQT=0
FOR
SET PSOHQ=$ORDER(PSOHY("PRCOM",PSOHQ))
if PSOHQ=""
QUIT
IF $GET(PSOHY("PRCOM",PSOHQ))'=""
SET PSOHQT=PSOHQT+1
SET ^PS(52.41,PSOCPEND,3,PSOHQT,0)=$GET(PSOHY("PRCOM",PSOHQ))
End DoDot:1
IF PSOHQT
SET ^PS(52.41,PSOCPEND,3,0)="^^"_PSOHQT_"^"_PSOHQT_"^"_DT_"^"
+29 ;indication for use and other language indication for use
SET $PIECE(^PS(52.41,PSOCPEND,4),"^",2,3)=$GET(PSOHY("IND"))_"^"_$GET(PSOHY("INDO"))
+30 IF $ORDER(PSOHY("SIG",0))
Begin DoDot:1
+31 SET PSOHQ=""
SET PSOHQT=0
FOR
SET PSOHQ=$ORDER(PSOHY("SIG",PSOHQ))
if PSOHQ=""
QUIT
IF $GET(PSOHY("SIG",PSOHQ))'=""
SET PSOHQT=PSOHQT+1
SET ^PS(52.41,PSOCPEND,"SIG",PSOHQT,0)=$GET(PSOHY("SIG",PSOHQ))
End DoDot:1
IF PSOHQT
SET ^PS(52.41,PSOCPEND,"SIG",0)="^52.4124A^"_PSOHQT_"^"_PSOHQT
+32 SET $PIECE(^PS(52.41,PSOCPEND,"INI"),"^")=$GET(PSOHINLO)
+33 ; add quantity/timing subfile information
+34 IF $ORDER(PSOHY("QTSUB",0))
Begin DoDot:1
+35 SET PSOHQ=""
SET PSOHQT=0
FOR
SET PSOHQ=$ORDER(PSOHY("QTSUB",PSOHQ))
if PSOHQ=""
QUIT
Begin DoDot:2
+36 IF $ORDER(PSOHY("QTSUB",PSOHQ,0))
SET PSOHQT=PSOHQT+1
+37 SET ^PS(52.41,PSOCPEND,1,PSOHQT,0)=PSOHY("QTSUB",PSOHQ,0)
+38 SET ^PS(52.41,PSOCPEND,1,PSOHQT,1)=PSOHY("QTSUB",PSOHQ,1)
+39 SET ^PS(52.41,PSOCPEND,1,PSOHQT,2)=PSOHY("QTSUB",PSOHQ,2)
End DoDot:2
End DoDot:1
IF PSOHQT
SET ^PS(52.41,PSOCPEND,1,0)="^52.413^"_PSOHQT_"^"_PSOHQT
+40 IF $ORDER(PINARY(0))
DO WP^DIE(52.41,PSOCPEND_",",105,"K","PINARY")
+41 ;Cross references not set yet preventing Pharmacy from finishing order
+42 DO EN^PSOHLSNC(PSOCPEND,"SN","IP")
+43 DO FULL^VALM1
+44 SET PSORDNUM=$PIECE($GET(^PS(52.41,PSOCPEND,0)),U)
+45 SET PSORDEA=$$FIND1^DIC(101.52,"","B",PSORDNUM)
+46 IF $EXTRACT($$GET1^DIQ(101.52,PSORDEA,1,"I"),*)'="S"
SET PSORDEA=""
+47 IF PSORDEA
SET PSORDFDA(101.52,PSORDEA_",",1)="@"
DO FILE^DIE("K","PSORDFDA")
+48 ;
+49 ;Just set to DC, don't delete because 52.41 entry would be re-used
+50 IF '$PIECE($GET(^PS(52.41,PSOCPEND,"EXT")),"^",2)
Begin DoDot:1
+51 ;x-ref shouldn't be set, but we'll kill them just in case
+52 KILL ^PS(52.41,"AOR",$PIECE(^PS(52.41,PSOCPEND,0),"^",2),+$PIECE($GET(^("INI")),"^"),PSOCPEND),^PS(52.41,"AD",$PIECE(^PS(52.41,PSOCPEND,0),"^",12),+$PIECE($GET(^("INI")),"^"),PSOCPEND)
+53 KILL ^PS(52.41,"ACL",+$PIECE(^PS(52.41,PSOCPEND,0),"^",13),$PIECE(^(0),"^",12),PSOCPEND),^PS(52.41,"AQ",+$PIECE($GET(^PS(52.41,PSOCPEND,0)),"^",21),PSOCPEND)
+54 SET $PIECE(^PS(52.41,PSOCPEND,4),"^")="External order, unable to successfully transmit to CPRS."
+55 IF $DATA(QUIET)
SET PSOEXCNT=PSOEXCNT+1
SET PSOEXMS(PSOEXCNT)="External order, unable to successfully transmit to CPRS."
+56 IF '$DATA(QUIET)
WRITE !!,"External order, unable to successfully transmit to CPRS."
+57 IF '$DATA(QUIET)
SET DIR(0)="E"
DO ^DIR
End DoDot:1
SET $PIECE(^PS(52.41,PSOCPEND,0),"^",3)="DC"
SET PSOEXCNT=PSOEXCNT+1
SET PSOEXMS(PSOEXCNT)="Unable to send CHCS order to CPRS."
QUIT
+58 ;Successful transmission to CPRS
+59 SET DA=PSOCPEND
SET DIK="^PS(52.41,"
DO IX^DIK
+60 ; add the pending outpatient order number to 52.49 and update status of eRx to PR (Processed)
+61 SET ERXSTA=$ORDER(^PS(52.45,"C","ERX","PR",0))
+62 SET ORDNUM=$PIECE($GET(^PS(52.41,PSOCPEND,0)),U)
+63 SET DIE="^PS(52.49,"
SET DR="25.2///"_PSOCPEND_";.12///"_ORDNUM
SET DA=PSOIEN
DO ^DIE
KILL DIE,DA,DR
+64 ; PSO*7*508 - add checks to update refill requests and responses
+65 ; add activity to status history
+66 IF MTYPE="N"
DO UPDSTAT^PSOERXU1(PSOIEN,"PR")
+67 IF MTYPE="RE"
DO UPDSTAT^PSOERXU1(PSOIEN,"RXP")
+68 ;B3S4
+69 IF MTYPE="CX"
Begin DoDot:1
+70 DO UPDSTAT^PSOERXU1(PSOIEN,"CXP")
+71 SET RTHID=$$GET1^DIQ(52.49,PSOIEN,.14)
SET RTHIEN=$ORDER(^PS(52.49,"FMID",RTHID,0))
+72 DO UPDSTAT^PSOERXU1(RTHIEN,"CRP")
End DoDot:1
+73 SET REQIEN=$$GETREQ^PSOERXU2(PSOIEN)
IF REQIEN
IF $$GET1^DIQ(52.49,REQIEN,.08,"I")="RR"
DO UPDSTAT^PSOERXU1(REQIEN,"RRP")
+74 ; PSO*7*508 - end
+75 ;
+76 ; Saves the Actual eRx SIG (from outside provider) into the PROVIDER COMMENTS field (P-651/14)
+77 NEW UNEXINS
SET UNEXINS(1)=$$ERXSIG^PSOERXUT(PSOIEN)
+78 IF $LENGTH($GET(UNEXINS(1)))
DO WP^DIE(52.41,PSOCPEND_",",9,"K","UNEXINS")
+79 ;
+80 IF '$DATA(QUIET)
Begin DoDot:1
+81 WRITE !!,"eRx #"_PSOHY("CHNUM")_" sent to PENDING ORDERS Queue."
+82 if $GET(MBMSITE)
WRITE " (Clinic: "_$$GET1^DIQ(44,+$GET(PSOHY("LOC")),.01)_")"
HANG 1.5
End DoDot:1
+83 ;PSO*7*520 - add sending and warning/information related to RxVerify Message.
+84 IF '$$UNACCBEF^PSOERX1H(PSOIEN)
IF MTYPE="N"!((MTYPE="RE")&(RESTYPE="R"))!(MTYPE="CX")
Begin DoDot:1
+85 WRITE !!,"Sending rxVerify Message to prescriber."
+86 DO POST^PSOERXO1(PSOIEN,.PSSRET,,,,1)
+87 ; if the post was unsuccessful, inform the user and quit.
+88 IF $PIECE(PSSRET(0),U)<1
WRITE !,$PIECE(PSSRET(0),U,2)
SET DIR(0)="E"
DO ^DIR
KILL DIR
QUIT
+89 IF $DATA(PSSRET("errorMessage"))
WRITE !,PSSRET("errorMessage")
SET DIR(0)="E"
DO ^DIR
KILL DIR
QUIT
+90 SET DIR(0)="E"
DO ^DIR
KILL DIR
End DoDot:1
+91 ;PSO*7*520 - end rxVerify changes
+92 ;
+93 KILL QUIET
+94 QUIT
+95 ;
ORDNUM() ; Returns the correct IEN for the ORDER file (#100) for the Rx
+1 IF $PIECE(XQY0,"^")="PSO LM BACKDOOR ORDERS"!($PIECE(XQY0,"^")="PSO LMOE FINISH")
IF $PIECE(VALMKEY,"^",2)="PSO HIDDEN ACTIONS"
IF $GET(RXN)
QUIT +$$GET1^DIQ(52,RXN,39.3,"I")
+2 IF $PIECE(XQY0,"^")="PSO LM BACKDOOR ORDERS"!($PIECE(XQY0,"^")="PSO LMOE FINISH")!($PIECE(XQY0,"^")="PSO PMP")
IF $PIECE(VALMKEY,"^",2)="PSO HIDDEN ACTIONS #3"!($PIECE(VALMKEY,"^",2)="PSO HIDDEN ACTIONS #4")
IF $GET(ORD)
QUIT +$$GET1^DIQ(52.41,+ORD,.01)
+3 IF $PIECE(XQY0,"^")="PSO VIEW"!($PIECE(XQY0,"^")="PSO PMP")
IF $PIECE(VALMKEY,"^",2)="PSO PMP HIDDEN ACTIONS MENU #2"
IF $GET(RXN)
QUIT +$$GET1^DIQ(52,RXN,39.3,"I")
+4 QUIT 0
