- PSOERX1B ;ALB/BWF - Accept eRx function ; 8/3/2016 5:14pm
- ;;7.0;OUTPATIENT PHARMACY;**467,506,520,527,508,551,591,606,581,617,700**;DEC 1997;Build 261
- ;
- Q
- ACVAL(PSOIEN,TYPE) ; NEW MTYPE, GET IT OFF FIELD .08, IF NOT DEFINED,
- ;Input: PSOIEN - eRx IEN (Pointer to #52.49)
- ; TYPE - Validation Type (P: Patient, PR: Provider, D: Drug)
- N MBMSITE,F,VBFLD,VBDTTMF,DIR,TAG,VALPAR,VAL,CURVAL,MVFLD,VBFLD,VBDTTMF,PSOIENS,RXSTAT,QFLG,VDTTM,ERXMMFLG,MTYPE,Y
- N RESTYPE,GMRA,GMRAL,ERXPTIEN,DFN
- S MBMSITE=$S($$GET1^DIQ(59.7,1,102,"I")="MBM":1,1:0)
- S F=52.49,PSOIENS=PSOIEN_","
- D FULL^VALM1
- S VALMBCK="R"
- ; first check to see if the entry exists. cannot validate something that has no value
- S MTYPE=$$GET1^DIQ(52.49,PSOIEN,.08,"I") ;mtype
- S RXSTAT=$$GET1^DIQ(52.49,PSOIEN,1,"E") I RXSTAT="RJ"!(RXSTAT="RM")!($E(RXSTAT,1,3)="REM")!(RXSTAT="PR")!(RXSTAT="CRP")!(RXSTAT="CXP")!(RXSTAT="RRP") D Q
- . W !!,"Cannot accept validation for a prescription with a status of 'Rejected',",!,"'Removed',or 'Processed",!
- . S DIR(0)="E" D ^DIR
- Q:TYPE']""
- S TAG=$S(TYPE="P":"patient",TYPE="PR":"provider",TYPE="D":"drug",1:"")
- S VALPAR=$S(TYPE="P":.05,TYPE="PR":2.3,TYPE="D":3.2,1:"") Q:VALPAR=""
- S VAL=$$GET1^DIQ(F,PSOIEN,VALPAR,"I") I 'VAL D Q
- . W !,"Vista "_TAG_" has not been matched. Cannot manually validate."
- . S DIR(0)="E" D ^DIR
- S MVFLD=$S(TYPE="P":1.7,TYPE="PR":1.3,TYPE="D":1.5,1:"")
- S VBFLD=$S(TYPE="P":1.13,TYPE="PR":1.8,TYPE="D":1.11,1:"")
- S VBDTTMF=$S(TYPE="P":1.14,TYPE="PR":1.9,TYPE="D":1.12,1:"")
- ; check if Patient has a valid adress - CS prescriptions only
- I TYPE="P",$$GET1^DIQ(52.49,PSOIEN,95.1,"I"),'$$VALPTADD^PSOERXUT(+$G(VAL)) D Q
- . W !!,"Unable to validate - VistA Patient does not have a current mailing"
- . W !,"or residential address on file.",$C(7),!
- . S DIR(0)="E" D ^DIR
- ; check to see if this is already validated
- I MVFLD S CURVAL=$$GET1^DIQ(F,PSOIEN,MVFLD,"I")
- I CURVAL D Q
- . W !!,"This "_TAG_" has already been "_$S(TYPE="PR"&$$GET1^DIQ(52.49,PSOIEN,2.7,"I"):"automatically",1:"manually")_" validated."
- . W !,"Validated By: "_$$GET1^DIQ(F,PSOIEN,VBFLD,"E")
- . W !,"Validated Date/Time: "_$$GET1^DIQ(F,PSOIEN,VBDTTMF,"E"),!
- . S DIR(0)="E" D ^DIR
- S QFLG=0
- I TYPE="D" D
- . W !
- . I '$O(^PS(52.49,PSOIEN,21,0)) W !,"Dosing information missing.",$C(7) S QFLG=1
- . I $$GET1^DIQ(52.49,PSOIEN,20.1,"E")="" W !,"Quantity missing.",$C(7) S QFLG=1
- . I $$GET1^DIQ(52.49,PSOIEN,20.2,"E")="" W !,"Days supply missing.",$C(7) S QFLG=1
- I $G(QFLG) W ! S DIR(0)="E" D ^DIR K DIR Q
- I TYPE="D" D
- . N ERXMSG,I
- . D PRDRVAL^PSOERXUT(.ERXMSG,"VD",PSOIEN) I $P(ERXMSG,"^",2)="B" S QFLG=1
- . I $O(ERXMSG(0)) D
- . . W !!,"*********************************",$S($P(ERXMSG,"^",2)="W":" WARNING(S) ",1:"INVALID DRUG"),"***********************************"
- . . S I=0 F S I=$O(ERXMSG(I)) Q:'I W !,$P(ERXMSG(I),"^")
- . . W !,"********************************************************************************",$C(7)
- I $G(QFLG) W ! S DIR(0)="E" D ^DIR K DIR Q
- ;
- I TYPE="P" D I '$G(ERXMMFLG) S DIR(0)="E" D ^DIR K DIR
- . S ERXMMFLG=$$PATWARN^PSOERX1A("VP",PSOIEN)
- ;
- S DFN=$$GET1^DIQ(52.49,PSOIEN,.05,"I")
- ; VistA Patient ChampVA Eligibility Check (MbM Only)
- I $G(MBMSITE),TYPE="P",'$$CHVAELIG^PSOERXU9(DFN) D Q
- . I ",N,I,W,RXI,RXN,RXW,RXR,CXI,CXN,CXW,"[(","_$G(RXSTAT)_",") D
- . . D UPDSTAT^PSOERXU1(PSOIEN,"HEL","Hold due to Eligibility Issue")
- . . W !!,"This eRx has been put on Hold (HEL) because the VistA Patient ("_$$GET1^DIQ(2,DFN,.01)_") is not Eligible for ChampVA Rx Benefit."
- . . K DIR D PAUSE^VALM1
- . D AUTOHOLD^PSOERX1E("E",PSOIEN,DFN)
- ;
- ; VistA Patient Allergy Check (MbM Only)
- I $G(MBMSITE),TYPE="P" D I $G(GMRAL)="" Q
- . S GMRA="0^0^111" D EN1^GMRADPT I $G(GMRAL)'="" Q
- . I ",N,I,W,RXI,RXN,RXW,RXR,CXI,CXN,CXW,"[(","_$G(RXSTAT)_",") D
- . . D UPDSTAT^PSOERXU1(PSOIEN,"HAL","Hold for Allergy Assessment")
- . . W !!,"This eRx has been put on Hold (HAL) because the VistA Patient ("_$$GET1^DIQ(2,DFN,.01)_") does not have an Allergy Assessment.."
- . . K DIR D PAUSE^VALM1
- . D AUTOHOLD^PSOERX1E("A",PSOIEN,DFN)
- ;
- I TYPE="P",'$G(ERXMMFLG) Q
- ;
- I TYPE="PR" S ERXMMFLG=$$PRVWARN^PSOERX1A("VP",PSOIEN) I 'ERXMMFLG S DIR(0)="E" D ^DIR K DIR Q
- W !,"Would you like to mark this "_TAG_" as VALIDATED?"
- S DIR(0)="Y",DIR("B")=$S($G(ERXMMFLG):"NO",1:"YES") D ^DIR Q:Y'=1
- K FDA,DIR
- S VDTTM=$$NOW^XLFDT I MVFLD S FDA(F,PSOIENS,MVFLD)=1
- I VBFLD S FDA(F,PSOIENS,VBFLD)=$G(DUZ)
- I VBDTTMF S FDA(F,PSOIENS,VBDTTMF)=VDTTM
- I $D(FDA) D FILE^DIE(,"FDA") K FDA
- W !,"Validation Updated!!"
- ; check validations and update status to 'wait' if all validations have occured.
- I MTYPE="N" D
- . I $$GET1^DIQ(52.49,PSOIEN,1.3,"I"),$$GET1^DIQ(52.49,PSOIEN,1.5,"I"),$$GET1^DIQ(52.49,PSOIEN,1.7,"I") D UPDSTAT^PSOERXU1(PSOIEN,"W") Q
- . D UPDSTAT^PSOERXU1(PSOIEN,"I")
- I MTYPE="RE" D
- . S RESTYPE=$$GET1^DIQ(52.49,PSOIEN,52.1,"I")
- . I RESTYPE'="R" D UPDSTAT^PSOERXU1(PSOIEN,"RXW") Q
- . I $$GET1^DIQ(52.49,PSOIEN,1.3,"I"),$$GET1^DIQ(52.49,PSOIEN,1.5,"I"),$$GET1^DIQ(52.49,PSOIEN,1.7,"I") D UPDSTAT^PSOERXU1(PSOIEN,"RXW") Q
- . D UPDSTAT^PSOERXU1(PSOIEN,"RXI")
- I MTYPE="CX" D
- . I $$GET1^DIQ(52.49,PSOIEN,1.3,"I"),$$GET1^DIQ(52.49,PSOIEN,1.5,"I"),$$GET1^DIQ(52.49,PSOIEN,1.7,"I") D UPDSTAT^PSOERXU1(PSOIEN,"CXW") Q
- . D UPDSTAT^PSOERXU1(PSOIEN,"CXI")
- I TYPE="P" D BPROC^PSOERXU8(PSOIEN,"PA",MVFLD,VBFLD,VBDTTMF,VDTTM) K @VALMAR D INIT^PSOERXP1
- I TYPE="PR" D BPROC^PSOERXU8(PSOIEN,"PR",MVFLD,VBFLD,VBDTTMF,VDTTM) K @VALMAR D INIT^PSOERXR1
- I TYPE="D" K @VALMAR D INIT^PSOERXD1
- 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
- ; 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
- S MBMSITE=$S($$GET1^DIQ(59.7,1,102,"I")="MBM":1,1:0)
- S F=52.49
- Q:'$G(PSOIEN)
- D FULL^VALM1
- S RXSTAT=$$GET1^DIQ(52.49,PSOIEN,1,"E") I RXSTAT="RJ"!(RXSTAT="RM")!($G(MBMSITE)&($E(RXSTAT,1,3)="REM"))!(RXSTAT="PR")!(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;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)
- .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(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
- 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 LOC=$G(PSODAT(F,PSOIENS,20.6,"I"))
- 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"))
- ; 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"))
- 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)
- ; always 'routine' for now
- S VAPRIOR="R"
- ; always 'new' for this version
- I '$L($G(ORDERTYP)) S ORDERTYP="NW"
- S PSOHY("LOC")=LOC,PSOHY("CHNUM")=$G(ERXNUM)
- S PSOHY("PICK")=VAROUT,PSOHY("ENTER")=PROVIEN
- 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
- 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.
- ; future consideration - do we need to check more fields?
- D ADD
- I $G(PSOEXMS)]"" W !,PSOEXMS S DIR(0)="E" D ^DIR K DIR
- K DFN
- Q
- ADD(QUIET) ;Add CHCS message to Outpatient Pending Orders file
- N PSOHQ,PSOHQT,PSOCPEND,PSOHINI,PSOHINLO,ERXSTA,ORDNUM,ILOOP,IARY,PSSRET,RESTYPE,RTHIEN,RTHID,X
- S (PSOHINI,PSOHINLO)=0 D
- .I $G(PSOHY("LOC")) S PSOHINLO=$P($G(^SC(PSOHY("LOC"),0)),"^",4) I PSOHINLO Q
- ; 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))
- 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
- ;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
- ; gather the unexpanded sig and file in 52.41
- S ILOOP=0 F S ILOOP=$O(^PS(52.49,PSOIEN,31,ILOOP)) Q:'ILOOP D
- .S IARY(ILOOP)=$G(^PS(52.49,PSOIEN,31,ILOOP,0))
- I $D(IARY) D WP^DIE(52.41,PSOCPEND_",",9,"K","IARY","IERR")
- I '$D(QUIET) W !!,"eRx #"_PSOHY("CHNUM")_" sent to PENDING OUTPATIENT ORDERS!"
- ;PSO*7*520 - add sending and warning/information related to RxVerify Message.
- I 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
- ;PSO*7*520 - end rxVerify changes
- K QUIET
- Q
- ; remove eRx from holding queue
- REM ;
- D REM^PSOERXU4
- Q
- ; unremove eRx from holding queue
- UNREM ;
- D UNREM^PSOERXU4
- Q
- ; reject eRx
- REJ ;
- D REJ^PSOERXU4
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSOERX1B 17847 printed Feb 18, 2025@23:54:38 Page 2
- PSOERX1B ;ALB/BWF - Accept eRx function ; 8/3/2016 5:14pm
- +1 ;;7.0;OUTPATIENT PHARMACY;**467,506,520,527,508,551,591,606,581,617,700**;DEC 1997;Build 261
- +2 ;
- +3 QUIT
- ACVAL(PSOIEN,TYPE) ; NEW MTYPE, GET IT OFF FIELD .08, IF NOT DEFINED,
- +1 ;Input: PSOIEN - eRx IEN (Pointer to #52.49)
- +2 ; TYPE - Validation Type (P: Patient, PR: Provider, D: Drug)
- +3 NEW MBMSITE,F,VBFLD,VBDTTMF,DIR,TAG,VALPAR,VAL,CURVAL,MVFLD,VBFLD,VBDTTMF,PSOIENS,RXSTAT,QFLG,VDTTM,ERXMMFLG,MTYPE,Y
- +4 NEW RESTYPE,GMRA,GMRAL,ERXPTIEN,DFN
- +5 SET MBMSITE=$SELECT($$GET1^DIQ(59.7,1,102,"I")="MBM":1,1:0)
- +6 SET F=52.49
- SET PSOIENS=PSOIEN_","
- +7 DO FULL^VALM1
- +8 SET VALMBCK="R"
- +9 ; first check to see if the entry exists. cannot validate something that has no value
- +10 ;mtype
- SET MTYPE=$$GET1^DIQ(52.49,PSOIEN,.08,"I")
- +11 SET RXSTAT=$$GET1^DIQ(52.49,PSOIEN,1,"E")
- IF RXSTAT="RJ"!(RXSTAT="RM")!($EXTRACT(RXSTAT,1,3)="REM")!(RXSTAT="PR")!(RXSTAT="CRP")!(RXSTAT="CXP")!(RXSTAT="RRP")
- Begin DoDot:1
- +12 WRITE !!,"Cannot accept validation for a prescription with a status of 'Rejected',",!,"'Removed',or 'Processed",!
- +13 SET DIR(0)="E"
- DO ^DIR
- End DoDot:1
- QUIT
- +14 if TYPE']""
- QUIT
- +15 SET TAG=$SELECT(TYPE="P":"patient",TYPE="PR":"provider",TYPE="D":"drug",1:"")
- +16 SET VALPAR=$SELECT(TYPE="P":.05,TYPE="PR":2.3,TYPE="D":3.2,1:"")
- if VALPAR=""
- QUIT
- +17 SET VAL=$$GET1^DIQ(F,PSOIEN,VALPAR,"I")
- IF 'VAL
- Begin DoDot:1
- +18 WRITE !,"Vista "_TAG_" has not been matched. Cannot manually validate."
- +19 SET DIR(0)="E"
- DO ^DIR
- End DoDot:1
- QUIT
- +20 SET MVFLD=$SELECT(TYPE="P":1.7,TYPE="PR":1.3,TYPE="D":1.5,1:"")
- +21 SET VBFLD=$SELECT(TYPE="P":1.13,TYPE="PR":1.8,TYPE="D":1.11,1:"")
- +22 SET VBDTTMF=$SELECT(TYPE="P":1.14,TYPE="PR":1.9,TYPE="D":1.12,1:"")
- +23 ; check if Patient has a valid adress - CS prescriptions only
- +24 IF TYPE="P"
- IF $$GET1^DIQ(52.49,PSOIEN,95.1,"I")
- IF '$$VALPTADD^PSOERXUT(+$GET(VAL))
- Begin DoDot:1
- +25 WRITE !!,"Unable to validate - VistA Patient does not have a current mailing"
- +26 WRITE !,"or residential address on file.",$CHAR(7),!
- +27 SET DIR(0)="E"
- DO ^DIR
- End DoDot:1
- QUIT
- +28 ; check to see if this is already validated
- +29 IF MVFLD
- SET CURVAL=$$GET1^DIQ(F,PSOIEN,MVFLD,"I")
- +30 IF CURVAL
- Begin DoDot:1
- +31 WRITE !!,"This "_TAG_" has already been "_$SELECT(TYPE="PR"&$$GET1^DIQ(52.49,PSOIEN,2.7,"I"):"automatically",1:"manually")_" validated."
- +32 WRITE !,"Validated By: "_$$GET1^DIQ(F,PSOIEN,VBFLD,"E")
- +33 WRITE !,"Validated Date/Time: "_$$GET1^DIQ(F,PSOIEN,VBDTTMF,"E"),!
- +34 SET DIR(0)="E"
- DO ^DIR
- End DoDot:1
- QUIT
- +35 SET QFLG=0
- +36 IF TYPE="D"
- Begin DoDot:1
- +37 WRITE !
- +38 IF '$ORDER(^PS(52.49,PSOIEN,21,0))
- WRITE !,"Dosing information missing.",$CHAR(7)
- SET QFLG=1
- +39 IF $$GET1^DIQ(52.49,PSOIEN,20.1,"E")=""
- WRITE !,"Quantity missing.",$CHAR(7)
- SET QFLG=1
- +40 IF $$GET1^DIQ(52.49,PSOIEN,20.2,"E")=""
- WRITE !,"Days supply missing.",$CHAR(7)
- SET QFLG=1
- End DoDot:1
- +41 IF $GET(QFLG)
- WRITE !
- SET DIR(0)="E"
- DO ^DIR
- KILL DIR
- QUIT
- +42 IF TYPE="D"
- Begin DoDot:1
- +43 NEW ERXMSG,I
- +44 DO PRDRVAL^PSOERXUT(.ERXMSG,"VD",PSOIEN)
- IF $PIECE(ERXMSG,"^",2)="B"
- SET QFLG=1
- +45 IF $ORDER(ERXMSG(0))
- Begin DoDot:2
- +46 WRITE !!,"*********************************",$SELECT($PIECE(ERXMSG,"^",2)="W":" WARNING(S) ",1:"INVALID DRUG"),"***********************************"
- +47 SET I=0
- FOR
- SET I=$ORDER(ERXMSG(I))
- if 'I
- QUIT
- WRITE !,$PIECE(ERXMSG(I),"^")
- +48 WRITE !,"********************************************************************************",$CHAR(7)
- End DoDot:2
- End DoDot:1
- +49 IF $GET(QFLG)
- WRITE !
- SET DIR(0)="E"
- DO ^DIR
- KILL DIR
- QUIT
- +50 ;
- +51 IF TYPE="P"
- Begin DoDot:1
- +52 SET ERXMMFLG=$$PATWARN^PSOERX1A("VP",PSOIEN)
- End DoDot:1
- IF '$GET(ERXMMFLG)
- SET DIR(0)="E"
- DO ^DIR
- KILL DIR
- +53 ;
- +54 SET DFN=$$GET1^DIQ(52.49,PSOIEN,.05,"I")
- +55 ; VistA Patient ChampVA Eligibility Check (MbM Only)
- +56 IF $GET(MBMSITE)
- IF TYPE="P"
- IF '$$CHVAELIG^PSOERXU9(DFN)
- Begin DoDot:1
- +57 IF ",N,I,W,RXI,RXN,RXW,RXR,CXI,CXN,CXW,"[(","_$GET(RXSTAT)_",")
- Begin DoDot:2
- +58 DO UPDSTAT^PSOERXU1(PSOIEN,"HEL","Hold due to Eligibility Issue")
- +59 WRITE !!,"This eRx has been put on Hold (HEL) because the VistA Patient ("_$$GET1^DIQ(2,DFN,.01)_") is not Eligible for ChampVA Rx Benefit."
- +60 KILL DIR
- DO PAUSE^VALM1
- End DoDot:2
- +61 DO AUTOHOLD^PSOERX1E("E",PSOIEN,DFN)
- End DoDot:1
- QUIT
- +62 ;
- +63 ; VistA Patient Allergy Check (MbM Only)
- +64 IF $GET(MBMSITE)
- IF TYPE="P"
- Begin DoDot:1
- +65 SET GMRA="0^0^111"
- DO EN1^GMRADPT
- IF $GET(GMRAL)'=""
- QUIT
- +66 IF ",N,I,W,RXI,RXN,RXW,RXR,CXI,CXN,CXW,"[(","_$GET(RXSTAT)_",")
- Begin DoDot:2
- +67 DO UPDSTAT^PSOERXU1(PSOIEN,"HAL","Hold for Allergy Assessment")
- +68 WRITE !!,"This eRx has been put on Hold (HAL) because the VistA Patient ("_$$GET1^DIQ(2,DFN,.01)_") does not have an Allergy Assessment.."
- +69 KILL DIR
- DO PAUSE^VALM1
- End DoDot:2
- +70 DO AUTOHOLD^PSOERX1E("A",PSOIEN,DFN)
- End DoDot:1
- IF $GET(GMRAL)=""
- QUIT
- +71 ;
- +72 IF TYPE="P"
- IF '$GET(ERXMMFLG)
- QUIT
- +73 ;
- +74 IF TYPE="PR"
- SET ERXMMFLG=$$PRVWARN^PSOERX1A("VP",PSOIEN)
- IF 'ERXMMFLG
- SET DIR(0)="E"
- DO ^DIR
- KILL DIR
- QUIT
- +75 WRITE !,"Would you like to mark this "_TAG_" as VALIDATED?"
- +76 SET DIR(0)="Y"
- SET DIR("B")=$SELECT($GET(ERXMMFLG):"NO",1:"YES")
- DO ^DIR
- if Y'=1
- QUIT
- +77 KILL FDA,DIR
- +78 SET VDTTM=$$NOW^XLFDT
- IF MVFLD
- SET FDA(F,PSOIENS,MVFLD)=1
- +79 IF VBFLD
- SET FDA(F,PSOIENS,VBFLD)=$GET(DUZ)
- +80 IF VBDTTMF
- SET FDA(F,PSOIENS,VBDTTMF)=VDTTM
- +81 IF $DATA(FDA)
- DO FILE^DIE(,"FDA")
- KILL FDA
- +82 WRITE !,"Validation Updated!!"
- +83 ; check validations and update status to 'wait' if all validations have occured.
- +84 IF MTYPE="N"
- Begin DoDot:1
- +85 IF $$GET1^DIQ(52.49,PSOIEN,1.3,"I")
- IF $$GET1^DIQ(52.49,PSOIEN,1.5,"I")
- IF $$GET1^DIQ(52.49,PSOIEN,1.7,"I")
- DO UPDSTAT^PSOERXU1(PSOIEN,"W")
- QUIT
- +86 DO UPDSTAT^PSOERXU1(PSOIEN,"I")
- End DoDot:1
- +87 IF MTYPE="RE"
- Begin DoDot:1
- +88 SET RESTYPE=$$GET1^DIQ(52.49,PSOIEN,52.1,"I")
- +89 IF RESTYPE'="R"
- DO UPDSTAT^PSOERXU1(PSOIEN,"RXW")
- QUIT
- +90 IF $$GET1^DIQ(52.49,PSOIEN,1.3,"I")
- IF $$GET1^DIQ(52.49,PSOIEN,1.5,"I")
- IF $$GET1^DIQ(52.49,PSOIEN,1.7,"I")
- DO UPDSTAT^PSOERXU1(PSOIEN,"RXW")
- QUIT
- +91 DO UPDSTAT^PSOERXU1(PSOIEN,"RXI")
- End DoDot:1
- +92 IF MTYPE="CX"
- Begin DoDot:1
- +93 IF $$GET1^DIQ(52.49,PSOIEN,1.3,"I")
- IF $$GET1^DIQ(52.49,PSOIEN,1.5,"I")
- IF $$GET1^DIQ(52.49,PSOIEN,1.7,"I")
- DO UPDSTAT^PSOERXU1(PSOIEN,"CXW")
- QUIT
- +94 DO UPDSTAT^PSOERXU1(PSOIEN,"CXI")
- End DoDot:1
- +95 IF TYPE="P"
- DO BPROC^PSOERXU8(PSOIEN,"PA",MVFLD,VBFLD,VBDTTMF,VDTTM)
- KILL @VALMAR
- DO INIT^PSOERXP1
- +96 IF TYPE="PR"
- DO BPROC^PSOERXU8(PSOIEN,"PR",MVFLD,VBFLD,VBDTTMF,VDTTM)
- KILL @VALMAR
- DO INIT^PSOERXR1
- +97 IF TYPE="D"
- KILL @VALMAR
- DO INIT^PSOERXD1
- +98 QUIT
- +99 ;PSOHY("LOC")=IEN of hospital location file (#44) - NOT USED,
- +100 ;PSOHY("CHNUM")=EXTERNAL PLACER ORDER NUMBER (NEED TO FIND OUT HOW WE SHOULD SET THIS) (25)
- +101 ;PSOHY("PICK")=MAIL/WINDOW (20.4)
- +102 ;PSOHY("ENTER")=ENTERED BY IEN (2.1)
- +103 ;PSOHY("PROV")=PROVIDER IEN (2.3)
- +104 ;PSOHY("SDT")=EFFECTIVE DATE (6.3)
- +105 ;PSOHY("ITEM")=PHARMACY ORDERABLE ITEM (DERIVED FROM THE DRUG IEN) - NO MAPPING TO 52.49
- +106 ;PSOHY("DRUG")=DRUG IEN (3.2)
- +107 ;PSOHY("QTY")=QUANTITY (20.1)
- +108 ;PSOHY("REF")=# OF REFILLS (20.5)
- +109 ;PSOHY("PAT")=PATIENT IEN (.05)
- +110 ;PSOHY("OCC")=ORDER TYPE (ALWAYS 'NW') - NO MAPPING TO 52.49
- +111 ;PSOHY("EDT")=LOGIN DATE/TIME (ERX MSG DATE/TIME #.03)
- +112 ;PSOHY("PRIOR")=PRIORITY (SET OF CODES, 52.41,25 - STAT, EMERGENCY, ROUTINE)
- +113 ;PSOHY("EXAPP")=EXTERNAL APPLICATION (FREE TEXT), LIKELY "PSO" - NO MAPPING TO 52.49
- +114 ;PSOHY("PRCOM",#)=PROVIDER COMMENTS (8- NOTES)
- +115 ;PSOHY("SIG",#)=SIG (52.4911 (STRUCTURED SIG), FIELD 1 (SIG FREE TEXT)
- +116 ;PSOHY("QTSUB",CNT)=QUANTITY TIMING SUBFILE DATA. MERGED IN, FULL SUBFILE DATA
- +117 ; 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
- +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
- +8 SET RXSTAT=$$GET1^DIQ(52.49,PSOIEN,1,"E")
- IF RXSTAT="RJ"!(RXSTAT="RM")!($GET(MBMSITE)&($EXTRACT(RXSTAT,1,3)="REM"))!(RXSTAT="PR")!(RXSTAT="RXP")
- Begin DoDot:1
- +9 WRITE !!,"Cannot accept a prescription with a status of 'Rejected', 'Removed',",!,"or 'Processed",!
- +10 SET DIR(0)="E"
- DO ^DIR
- End DoDot:1
- QUIT
- +11 SET PSOIENS=PSOIEN_","
- +12 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;30;52.1","IE","PSODAT")
- +13 SET PSOEXCNT=0
- +14 SET MTYPE=$GET(PSODAT(F,PSOIENS,.08,"I"))
- +15 SET RESTYPE=$GET(PSODAT(F,PSOIENS,52.1,"I"))
- +16 IF MTYPE="RE"
- IF RESTYPE'="R"
- Begin DoDot:1
- +17 SET REQIEN=$$GETREQ^PSOERXU2(PSOIEN)
- +18 IF REQIEN
- SET RXIEN=$$GET1^DIQ(52.49,REQIEN,.13,"I")
- +19 DO PREFRES^PSOERXU3(PSOIEN,.PSOHY,.PSOEXCNT,.PSOEXMS,.PSODAT)
- +20 DO RRDELTA^PSOERXU2(.DELTAS,REQIEN,PSOIEN)
- +21 IF $ORDER(PSOEXMS(0))
- IF RESTYPE="AWC"
- IF $DATA(DELTAS(52.49,"EXTERNAL PROVIDER"))
- Begin DoDot:2
- +22 DO MSGDIR^PSOERXU1(.PSOEXMS)
- End DoDot:2
- QUIT
- +23 IF $ORDER(PSOEXMS(0))
- IF $EXTRACT(RESTYPE)="A"
- IF '$DATA(DELTAS(52.49,"EXTERNAL PROVIDER"))
- Begin DoDot:2
- +24 DO UPDSTAT^PSOERXU1(PSOIEN,"RXF","Unable to add order to Pending file.")
- QUIT
- End DoDot:2
- QUIT
- +25 IF $DATA(DELTAS(52.49,"EXTERNAL PROVIDER"))
- DO ADD
- QUIT
- +26 ; call using silent mode if this is auto-processing
- +27 DO ADD(1)
- End DoDot:1
- QUIT
- +28 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
- +29 IF MTYPE="N"!(MTYPE="RE"&(RESTYPE="R")!(MTYPE="CX"))
- Begin DoDot:1
- +30 SET PMVAL=$GET(PSODAT(F,PSOIENS,1.7,"I"))
- IF 'PMVAL
- SET PSOEXCNT=PSOEXCNT+1
- SET PSOEXMS(PSOEXCNT)="Patient has not been manually validated."
- +31 SET PRMVAL=$GET(PSODAT(F,PSOIENS,1.3,"I"))
- IF 'PRMVAL
- SET PSOEXCNT=PSOEXCNT+1
- SET PSOEXMS(PSOEXCNT)="Provider has not been manually validated."
- +32 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
- +33 ; for now, if validations have not occurred, do not check the other fields.
- +34 IF $ORDER(PSOEXMS(0))
- DO MSGDIR^PSOERXU1(.PSOEXMS)
- QUIT
- +35 SET POORD=$GET(PSODAT(F,PSOIENS,25.2,"I"))
- IF POORD
- SET PSOEXCNT=PSOEXCNT+1
- SET PSOEXMS(PSOEXCNT)="Pending outpatient order already exists."
- +36 SET PATIEN=$GET(PSODAT(F,PSOIENS,.05,"I"))
- IF 'PATIEN
- SET PSOEXCNT=PSOEXCNT+1
- SET PSOEXMS(PSOEXCNT)="No matched vista patient."
- +37 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."
- +38 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."
- +39 SET LOC=$GET(PSODAT(F,PSOIENS,20.6,"I"))
- +40 SET ERXNUM=$GET(PSODAT(F,PSOIENS,.01,"E"))
- IF 'ERXNUM
- SET PSOEXCNT=PSOEXCNT+1
- SET PSOEXMS(PSOEXCNT)="eRx number missing."
- +41 SET VQTY=$GET(PSODAT(F,PSOIENS,20.1,"E"))
- IF 'VQTY
- SET PSOEXCNT=PSOEXCNT+1
- SET PSOEXMS(PSOEXCNT)="Quantity missing."
- +42 SET EFFDT=$GET(PSODAT(F,PSOIENS,6.3,"I"))
- SET WRITDT=$GET(PSODAT(F,PSOIENS,5.9,"I"))
- +43 ; if the effective date is passed in and there is no time, add .000001 to the date
- +44 IF EFFDT]""
- SET EFFDT=$PIECE(EFFDT,".")
- +45 IF '$LENGTH(EFFDT)
- SET EFFDT=WRITDT
- +46 SET VADAYS=$GET(PSODAT(F,PSOIENS,20.2,"E"))
- +47 SET VAOI=$$GET1^DIQ(50,VADRUG,2.1,"I")
- IF 'VAOI
- SET PSOEXCNT=PSOEXCNT+1
- SET PSOEXMS(PSOEXCNT)="Orderable item not associated with drug."
- +48 SET VAREF=$GET(PSODAT(F,PSOIENS,20.5,"E"))
- +49 SET VAROUT=$GET(PSODAT(F,PSOIENS,20.4,"I"))
- IF '$LENGTH(VAROUT)
- SET PSOEXCNT=PSOEXCNT+1
- SET PSOEXMS(PSOEXCNT)="Pickup routing missing."
- +50 SET PATINST=$GET(PSODAT(F,PSOIENS,27,"E"))
- +51 DO TXT2ARY^PSOERXD1(.PINARY,$$LSIG^PSOERXU6(PATINST))
- +52 ; get provider comments from VA PROVIDER COMMENTS field
- +53 SET PRVCOMM=$GET(PSODAT(F,PSOIENS,30,"E"))
- +54 DO TXT2ARY^PSOERXD1(.PRVARY,$$LSIG^PSOERXU6(PRVCOMM))
- +55 SET (PLOOP,PCNT)=0
- FOR
- SET PLOOP=$ORDER(PRVARY(PLOOP))
- if 'PLOOP
- QUIT
- Begin DoDot:1
- +56 SET PCNT=PCNT+1
- SET PSOHY("PRCOM",PCNT)=$GET(PRVARY(PLOOP))
- End DoDot:1
- +57 IF '$ORDER(^PS(52.49,PSOIEN,21,0))
- SET PSOEXCNT=PSOEXCNT+1
- SET PSOEXMS(PSOEXCNT)="Dosing information missing."
- +58 SET (QTLOOP,QTCNT)=0
- FOR
- SET QTLOOP=$ORDER(^PS(52.49,PSOIEN,21,QTLOOP))
- if 'QTLOOP
- QUIT
- Begin DoDot:1
- +59 SET QTCNT=QTCNT+1
- MERGE PSOHY("QTSUB",QTCNT)=^PS(52.49,PSOIEN,21,QTLOOP)
- End DoDot:1
- +60 ; always 'routine' for now
- +61 SET VAPRIOR="R"
- +62 ; always 'new' for this version
- +63 IF '$LENGTH($GET(ORDERTYP))
- SET ORDERTYP="NW"
- +64 SET PSOHY("LOC")=LOC
- SET PSOHY("CHNUM")=$GET(ERXNUM)
- +65 SET PSOHY("PICK")=VAROUT
- SET PSOHY("ENTER")=PROVIEN
- +66 SET PSOHY("PROV")=PROVIEN
- SET PSOHY("SDT")=EFFDT
- +67 SET PSOHY("ITEM")=VAOI
- SET PSOHY("DRUG")=VADRUG
- +68 SET PSOHY("QTY")=VQTY
- SET PSOHY("REF")=VAREF
- +69 SET (PSOHY("PAT"),DFN)=PATIEN
- SET PSOHY("OCC")=ORDERTYP
- +70 ; Login date will always be the Message Received Date/Time
- +71 SET PSOHY("EDT")=$$GET1^DIQ(52.49,PSOIEN,.03,"I")
- SET PSOHY("PRIOR")=VAPRIOR
- +72 ; ALWAYS PSO as the external application
- +73 SET PSOHY("EXAPP")="PHARMACY"
- +74 SET PSOHY("DAYS")=VADAYS
- +75 ; sig from eRx
- +76 SET (SLOOP,SCNT)=0
- FOR
- SET SLOOP=$ORDER(^PS(52.49,PSOIEN,"SIG",SLOOP))
- if 'SLOOP
- QUIT
- Begin DoDot:1
- +77 SET SIGDAT=$GET(^PS(52.49,PSOIEN,"SIG",SLOOP,0))
- +78 SET SCNT=SCNT+1
- SET PSOHY("SIG",SCNT)=SIGDAT
- End DoDot:1
- +79 SET SLOOP2=0
- FOR
- SET SLOOP2=$ORDER(PINARY(SLOOP2))
- if 'SLOOP2
- QUIT
- Begin DoDot:1
- +80 SET SCNT=SCNT+1
- SET PSOHY("SIG",SCNT)=$GET(PINARY(SLOOP2))
- End DoDot:1
- +81 ; if provider, patient or drug is missing, no need to continue.
- +82 ; future consideration - do we need to check more fields?
- +83 DO ADD
- +84 IF $GET(PSOEXMS)]""
- WRITE !,PSOEXMS
- SET DIR(0)="E"
- DO ^DIR
- KILL DIR
- +85 KILL DFN
- +86 QUIT
- ADD(QUIET) ;Add CHCS message to Outpatient Pending Orders file
- +1 NEW PSOHQ,PSOHQT,PSOCPEND,PSOHINI,PSOHINLO,ERXSTA,ORDNUM,ILOOP,IARY,PSSRET,RESTYPE,RTHIEN,RTHID,X
- +2 SET (PSOHINI,PSOHINLO)=0
- Begin DoDot:1
- +3 IF $GET(PSOHY("LOC"))
- SET PSOHINLO=$PIECE($GET(^SC(PSOHY("LOC"),0)),"^",4)
- IF PSOHINLO
- QUIT
- End DoDot:1
- +4 ; get institution from 52.49 if clinic was not passed in
- +5 SET RESTYPE=$$GET1^DIQ(52.49,PSOIEN,52.1,"I")
- +6 IF $GET(PSOHINLO)<1
- SET PSOHINLO=$$GET1^DIQ(52.49,PSOIEN,24.1,"I")
- +7 IF +$GET(PSOHINLO)<1
- SET PSOEXCNT=PSOEXCNT+1
- SET PSOEXMS(PSOEXCNT)="Unable to derive Institution from Clinic."
- QUIT
- +8 KILL DD,DO,DIC
- SET X=PSOHY("CHNUM")
- SET DIC="^PS(52.41,"
- SET DIC(0)="L"
- +9 if $GET(PSOHY("PICK"))=""
- SET PSOHY("PICK")="M"
- +10 SET DIC("DR")="4////"_$GET(PSOHY("ENTER"))_";5////"_PSOHY("PROV")_";6////"_$GET(PSOHY("SDT"))_";8////"_PSOHY("ITEM")_";11////"_PSOHY("DRUG")
- +11 SET DIC("DR")=$GET(DIC("DR"))_";12////"_$GET(PSOHY("QTY"))_";13////"_$GET(PSOHY("REF"))_";22.1////"_$GET(PSOHY("PREVORD"))_";101////"_$GET(PSOHY("DAYS"))
- +12 DO FILE^DICN
- KILL DD,DIC,DO
- IF Y<0
- Begin DoDot:1
- +13 SET PSOEXCNT=PSOEXCNT+1
- SET PSOEXMS(PSOEXCNT)="Unable to add order to Pending file."
- +14 IF MTYPE="RE"
- DO UPDSTAT^PSOERXU1(PSOIEN,"RXF",PSOEXMS(PSOEXCNT))
- +15 SET REQIEN=$$GETREQ^PSOERXU2(PSOIEN)
- IF REQIEN
- DO UPDSTAT^PSOERXU1(PSOIEN,"RRF",PSOEXMS)
- End DoDot:1
- QUIT
- +16 SET PSOCPEND=+Y
- +17 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"))
- +18 SET $PIECE(^PS(52.41,PSOCPEND,0),"^",14)=$GET(PSOHY("PRIOR"))
- SET $PIECE(^(0),"^",17)=$GET(PSOHY("PICK"))
- +19 SET $PIECE(^PS(52.41,PSOCPEND,"EXT"),"^")=PSOHY("CHNUM")
- SET $PIECE(^("EXT"),"^",2)=0
- SET $PIECE(^("EXT"),"^",3)=PSOHY("EXAPP")
- +20 SET DIE="^PS(52.41,"
- SET DA=PSOCPEND
- SET DR="104.1///1"
- DO ^DIE
- KILL DIE,DA,DR
- +21 ; PSO*7*506
- +22 SET FDA(52.41,PSOCPEND_",",104)=$GET(PATINST)
- DO FILE^DIE(,"FDA")
- KILL FDA
- +23 NEW DA,DIK
- SET DA=PSOCPEND
- SET DIK="^PS(52.41,"
- SET DIK(1)="114^C"
- DO EN1^DIK
- +24 IF $ORDER(PSOHY("PRCOM",0))
- Begin DoDot:1
- +25 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_"^"
- +26 IF $ORDER(PSOHY("SIG",0))
- Begin DoDot:1
- +27 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
- +28 SET $PIECE(^PS(52.41,PSOCPEND,"INI"),"^")=$GET(PSOHINLO)
- +29 ; add quantity/timing subfile information
- +30 IF $ORDER(PSOHY("QTSUB",0))
- Begin DoDot:1
- +31 SET PSOHQ=""
- SET PSOHQT=0
- FOR
- SET PSOHQ=$ORDER(PSOHY("QTSUB",PSOHQ))
- if PSOHQ=""
- QUIT
- Begin DoDot:2
- +32 IF $ORDER(PSOHY("QTSUB",PSOHQ,0))
- SET PSOHQT=PSOHQT+1
- +33 SET ^PS(52.41,PSOCPEND,1,PSOHQT,0)=PSOHY("QTSUB",PSOHQ,0)
- +34 SET ^PS(52.41,PSOCPEND,1,PSOHQT,1)=PSOHY("QTSUB",PSOHQ,1)
- +35 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
- +36 IF $ORDER(PINARY(0))
- DO WP^DIE(52.41,PSOCPEND_",",105,"K","PINARY")
- +37 ;Cross references not set yet preventing Pharmacy from finishing order
- +38 DO EN^PSOHLSNC(PSOCPEND,"SN","IP")
- +39 DO FULL^VALM1
- +40 ;Just set to DC, don't delete because 52.41 entry would be re-used
- +41 IF '$PIECE($GET(^PS(52.41,PSOCPEND,"EXT")),"^",2)
- Begin DoDot:1
- +42 ;x-ref shouldn't be set, but we'll kill them just in case
- +43 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)
- +44 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)
- +45 SET $PIECE(^PS(52.41,PSOCPEND,4),"^")="External order, unable to successfully transmit to CPRS."
- +46 IF $DATA(QUIET)
- SET PSOEXCNT=PSOEXCNT+1
- SET PSOEXMS(PSOEXCNT)="External order, unable to successfully transmit to CPRS."
- +47 IF '$DATA(QUIET)
- WRITE !!,"External order, unable to successfully transmit to CPRS."
- +48 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
- +49 ;Successful transmission to CPRS
- +50 SET DA=PSOCPEND
- SET DIK="^PS(52.41,"
- DO IX^DIK
- +51 ; add the pending outpatient order number to 52.49 and update status of eRx to PR (Processed)
- +52 SET ERXSTA=$ORDER(^PS(52.45,"C","ERX","PR",0))
- +53 SET ORDNUM=$PIECE($GET(^PS(52.41,PSOCPEND,0)),U)
- +54 SET DIE="^PS(52.49,"
- SET DR="25.2///"_PSOCPEND_";.12///"_ORDNUM
- SET DA=PSOIEN
- DO ^DIE
- KILL DIE,DA,DR
- +55 ; PSO*7*508 - add checks to update refill requests and responses
- +56 ; add activity to status history
- +57 IF MTYPE="N"
- DO UPDSTAT^PSOERXU1(PSOIEN,"PR")
- +58 IF MTYPE="RE"
- DO UPDSTAT^PSOERXU1(PSOIEN,"RXP")
- +59 ;B3S4
- +60 IF MTYPE="CX"
- Begin DoDot:1
- +61 DO UPDSTAT^PSOERXU1(PSOIEN,"CXP")
- +62 SET RTHID=$$GET1^DIQ(52.49,PSOIEN,.14)
- SET RTHIEN=$ORDER(^PS(52.49,"FMID",RTHID,0))
- +63 DO UPDSTAT^PSOERXU1(RTHIEN,"CRP")
- End DoDot:1
- +64 SET REQIEN=$$GETREQ^PSOERXU2(PSOIEN)
- IF REQIEN
- IF $$GET1^DIQ(52.49,REQIEN,.08,"I")="RR"
- DO UPDSTAT^PSOERXU1(REQIEN,"RRP")
- +65 ; PSO*7*508 - end
- +66 ; gather the unexpanded sig and file in 52.41
- +67 SET ILOOP=0
- FOR
- SET ILOOP=$ORDER(^PS(52.49,PSOIEN,31,ILOOP))
- if 'ILOOP
- QUIT
- Begin DoDot:1
- +68 SET IARY(ILOOP)=$GET(^PS(52.49,PSOIEN,31,ILOOP,0))
- End DoDot:1
- +69 IF $DATA(IARY)
- DO WP^DIE(52.41,PSOCPEND_",",9,"K","IARY","IERR")
- +70 IF '$DATA(QUIET)
- WRITE !!,"eRx #"_PSOHY("CHNUM")_" sent to PENDING OUTPATIENT ORDERS!"
- +71 ;PSO*7*520 - add sending and warning/information related to RxVerify Message.
- +72 IF MTYPE="N"!((MTYPE="RE")&(RESTYPE="R"))!(MTYPE="CX")
- Begin DoDot:1
- +73 WRITE !!,"Sending rxVerify Message to prescriber."
- +74 DO POST^PSOERXO1(PSOIEN,.PSSRET,,,,1)
- +75 ; if the post was unsuccessful, inform the user and quit.
- +76 IF $PIECE(PSSRET(0),U)<1
- WRITE !,$PIECE(PSSRET(0),U,2)
- SET DIR(0)="E"
- DO ^DIR
- KILL DIR
- QUIT
- +77 IF $DATA(PSSRET("errorMessage"))
- WRITE !,PSSRET("errorMessage")
- SET DIR(0)="E"
- DO ^DIR
- KILL DIR
- QUIT
- End DoDot:1
- +78 ;PSO*7*520 - end rxVerify changes
- +79 KILL QUIET
- +80 QUIT
- +81 ; remove eRx from holding queue
- REM ;
- +1 DO REM^PSOERXU4
- +2 QUIT
- +3 ; unremove eRx from holding queue
- UNREM ;
- +1 DO UNREM^PSOERXU4
- +2 QUIT
- +3 ; reject eRx
- REJ ;
- +1 DO REJ^PSOERXU4