- PSOERXX1 ;ALB/BWF - eRx xml utilities ; 8/3/2016 5:14pm
- ;;7.0;OUTPATIENT PHARMACY;**467,520,527,508,581,617**;DEC 1997;Build 110
- ;
- Q
- ; called by PSO ERX RX RENEWAL REQUEST action protocol
- RREQLST(PSOLST,PSOSITE,PSOCNT) ;
- N ITEM,SEL,ORD,I,ERXIEN,DONE,ORDER,ORDLST,RXIEN,RXDRUG,RXDRUGN,PRECHECK,DIR
- D FULL^VALM1
- S DIR("A")="Select Orders by number",DIR(0)="LO^1:"_PSOCNT D ^DIR I $D(DTOUT)!($D(DUOUT)) K DIR,DIRUT,DTOUT,DUOUT Q
- S ORDLST=Y
- W !!,"NOTE: If you have selected items that are not inbound eRx Prescriptions,"
- W !,"those entries will be skipped during the RxRenewal process.",!!
- K DIR
- S DONE=0
- F I=1:1 D Q:DONE
- .S ITEM=$P(ORDLST,",",I) I ITEM="" S DONE=1 Q
- .I $P(PSOLST(ITEM),U)'=52 W !,"This item is "_$P(PSOLST(ITEM),U,3)_" and cannot be renewed.",! D DIRE Q
- .S RXIEN=$P(PSOLST(ITEM),U,2)
- .S ORDER=$$GET1^DIQ(52,RXIEN,39.3,"I")
- .S ERXIEN=$$CHKERX^PSOERXU1(ORDER) Q:'ERXIEN
- .S RXDRUG=$$GET1^DIQ(52,RXIEN,6,"I"),RXDRUGN=$$GET1^DIQ(52,RXIEN,6,"E")
- .W !!,"Now renewing prescription #: "_$$GET1^DIQ(52,RXIEN,.01,"E")
- .W !,"Patient: "_$$GET1^DIQ(52,RXIEN,2,"E")
- .W !,"Drug/Supply: "_RXDRUGN
- .W !,"# of Refills: "_$$GET1^DIQ(52,RXIEN,9,"E"),?30,"Days Supply: "_$$GET1^DIQ(52,RXIEN,8,"E"),?52,"Quantity: "_$$GET1^DIQ(52,RXIEN,7,"E")
- .S PRECHECK=$$RENEW^PSORENW(RXIEN,RXDRUG)
- .I $P(PRECHECK,U)<1 W !,$P(PRECHECK,U,2),! D DIRE Q
- .D RREQOP(ERXIEN,PSOSITE)
- Q
- ; Called by PSO ERX SINGLE RX RENEWAL REQUEST action protocol
- RREQSIN(RXIEN,PSOSITE) ;
- N ORDER,ERXIEN,RXDRUG,RXDRUGN,PRECHECK
- S ORDER=$$GET1^DIQ(52,RXIEN,39.3,"I") Q:'ORDER
- S ERXIEN=$$CHKERX^PSOERXU1(ORDER) I 'ERXIEN W !!,"RxRenewal request may not be used. This prescription is not an eRx." D DIRE Q
- S RXDRUG=$$GET1^DIQ(52,RXIEN,6,"I"),RXDRUGN=$$GET1^DIQ(52,RXIEN,6,"E")
- W !!,"Now renewing prescription #: "_$$GET1^DIQ(52,RXIEN,.01,"E")
- W !,"Patient: "_$$GET1^DIQ(52,RXIEN,2,"E")
- W !,"Drug/Supply: "_RXDRUGN,!!
- W !,"# of Refills: "_$$GET1^DIQ(52,RXIEN,9,"E"),?30,"Days Supply: "_$$GET1^DIQ(52,RXIEN,8,"E"),?52,"Quantity: "_$$GET1^DIQ(52,RXIEN,7,"E")
- S PRECHECK=$$RENEW^PSORENW(RXIEN,RXDRUG)
- I $P(PRECHECK,U)<1 W !,$P(PRECHECK,U,2),! Q
- D RREQOP(ERXIEN,PSOSITE)
- Q
- ; PSOIEN - ien from 52.49 (erx holding queue)
- ; PSOSITE - site ien from the outpatient site file (59)
- ; RX RENEWAL REQUEST VIA PSO LMOE FINISH/BACKDOOR ORDERS
- RREQOP(PSOIEN,PSOSITE) ;
- N ORNUM,RXIEN,PSSOUT,GBL,REFL,I,EXDT,PEND,PSSRET,CNT,DIR,Y,REFQTY,REFREQ,DIV,VADAT,RRCNT
- N I,SSSTART,SSSTOP,GBL2,XXL1,XXL2,HUBID,NPIINST,STATION,Y,DIR,DONE,INNAME,NPI,NERXIEN,PROHIBIT1,PROHIBIT
- N MSGIEN,MSGDT,RESIEN,SIG,SIGLEN,DTCUT,RTHID,PSORENW,EXPFLG,S2017,MTYPE,RESVAL,REQIEN
- S VALMBCK="R"
- Q:'PSOIEN!('PSOSITE)
- S MTYPE=$$GET1^DIQ(52.49,PSOIEN,.08,"I")
- I MTYPE="CX" S NERXIEN=$$FINDNRX^PSOERXU6(PSOIEN)
- I MTYPE="CX" S PROHIBIT=$$GET1^DIQ(52.49,NERXIEN,301.3,"I")
- I MTYPE'="CX" S PROHIBIT=$$GET1^DIQ(52.49,PSOIEN,301.3,"I")
- I PROHIBIT W !!,"Renewals are prohibited for this eRx." D DIRE Q
- S RESVAL=$$GET1^DIQ(52.49,PSOIEN,52.1,"I")
- S S2017=$$GET1^DIQ(52.49,PSOIEN,312.1,"I")
- S NPIINST=$$GET1^DIQ(59,PSOSITE,101,"I")
- S INNAME=$$NAME^XUAF4(NPIINST)
- S STATION=$$WHAT^XUAF4(NPIINST,99)
- D FULL^VALM1
- ; bwf - if the NPI is not coming back from the $$NPI check, we have to pull it from the field
- ; iteself
- S NPI=$$NPI^XUSNPI("Organization_ID",NPIINST) I $P(NPI,U)<1 D
- .S NPI=$$WHAT^XUAF4(NPIINST,41.99)
- I '$G(NPI) W !!,"NPI could not be established. Cannot create renewal request." D DIRE Q
- S DIV=INNAME_U_NPI
- S ORNUM=$$GET1^DIQ(52.49,PSOIEN,.12,"I") I 'ORNUM W !!,"No OE/RR order number. Cannot create renewal request." D DIRE Q
- S PEND=$O(^PS(52.41,"B",ORNUM,0))
- S RXIEN=$O(^PSRX("APL",ORNUM,0))
- I PEND,'RXIEN W !!,"RX appears to be in Pending Outpatient Orders, but not yet processed to",!,"backdoor orders." D DIRE Q
- I 'PEND,'RXIEN W !!,"Cannot resolve RX#. Please ensure the prescription is in the prescription file." D DIRE Q
- I $$GET1^DIQ(52,RXIEN,100,"I")=5 W !!,"Rx is in suspense, cannot renew prescription." D DIRE Q
- S PSORENW("ORX #")=$$GET1^DIQ(52,RXIEN,.01,"E")
- I $A($E(PSORENW("ORX #"),$L(PSORENW("ORX #"))))'<90 W !!,"Cannot renew Rx # "_PSORENW("ORX #")_", Max number reached." D DIRE Q
- S EXDT=$$GET1^DIQ(52,RXIEN,26,"I")
- I EXDT<$$FMADD^XLFDT(DT,-120) W !!,"Medication has expired, cannot renew prescription." D DIRE Q
- I EXDT<DT S EXPFLG=1
- S REFL=$$GET1^DIQ(52,RXIEN,9,"I"),I=0 F S I=$O(^PSRX(RXIEN,1,I)) Q:'I S REFL=REFL-1
- I REFL>0,'$G(EXPFLG) W !!,"Refills remaining for this prescription. Cannot create RxRenewal request." D DIRE Q
- S (SIG,SIGLEN)=0 F S SIG=$O(^PSRX(RXIEN,"INS1",SIG)) Q:'SIG D
- .S SIGLEN=$G(SIGLEN)+$L(^PSRX(RXIEN,"INS1",SIG,0))
- I 'S2017,SIGLEN>140 W !!,"Sig is greater than 140 characters. Cannot create renewal request." D DIRE Q
- S (DONE,RRCNT)=0,DTCUT=$$FMADD^XLFDT(DT,-30)
- S REQIEN=$$GETREQ^PSOERXU2(PSOIEN)
- S MSGIEN=999999999 F S MSGIEN=$O(^PS(52.49,PSOIEN,201,"B",MSGIEN),-1) Q:'MSGIEN D
- .I $$GET1^DIQ(52.49,MSGIEN,.08,"I")'="RR" Q
- .; if this is a renwal response/replace type, and the record is the related request, quit (dont show this one)
- .I MTYPE="RE",RESVAL="R",MSGIEN=REQIEN,$$GET1^DIQ(52.49,REQIEN,.08,"I")="RR" Q
- .S MSGDT=$$GET1^DIQ(52.49,MSGIEN,.03,"I")
- .I MSGDT<DTCUT S DONE=1 Q
- .S RRCNT=$G(RRCNT)+1
- .S RESIEN=$$GETRESP^PSOERXU2(MSGIEN)
- .W !!,"********************************************************************"
- .W !!,"Previous RxRenewal Request Date/Time: "_$$FMTE^XLFDT(MSGDT)
- .W !,"RxRenewal Requested by: "_$$GET1^DIQ(52.49,MSGIEN,51.1,"E")
- .W !,"# of Refills Requested: "_$$GET1^DIQ(52.49,MSGIEN,51.2,"E")
- .I 'RESIEN D Q
- ..W !!,"***No response received from provider.***",!
- ..S DIR(0)="E" D ^DIR K DIR
- .W !!,"RxRenewal response Date/Time: "_$$GET1^DIQ(52.49,RESIEN,.03,"E")
- .W !!,"RxRenewal response status: "_$$GET1^DIQ(52.49,RESIEN,1,"E")
- .W !!,"********************************************************************"
- I RRCNT>0 W !!,"Total Number of RxRenewal requests in the last 30 days: "_RRCNT,!!
- I RRCNT D Q:'Y
- .K DIR S DIR(0)="YO",DIR("B")="N",DIR("A")="Are you sure you would like to send ANOTHER RxRenewal request" D ^DIR
- W !!,"Generating RxRenewal request for Rx #: "_$$GET1^DIQ(52,RXIEN,.01,"E"),!!
- K DIR S DIR(0)="SO^R:RENEW WITH PRE-POPULATED VALUE;C:CHANGE # OF REFILLS;E:EXIT"
- S DIR("?")=" E - Exit"
- S DIR("?",1)=" R - Request the same # of refills as the original Rx"
- S DIR("?",2)=" C - Request desired # of refills (0-11)"
- D ^DIR K DIR
- I Y="E"!$D(DIRUT)!(Y="^") Q
- ;Med Dispensed segments when the Qualifier is 'P' ('n' is the original Refill value sent on NEWRX)
- S REFQTY=$$GET1^DIQ(52,RXIEN,9,"I")
- I Y="R" D
- .S REFREQ=REFQTY
- ;Refill with change Quantity (questions to be displayed to the user such as # of refills, Pharmacist Notes and so on)
- S DONE=0
- I Y="C" D
- .F D Q:DONE!($G(REFREQ)'="")
- ..S DIR(0)="NO^0:11",DIR("A")="Enter # of Refills or '^' to exit" D ^DIR K DIR
- ..Q:Y=""
- ..I Y="^"!$D(DIRUT) S DONE=1 Q
- ..S REFREQ=Y
- Q:DONE=1
- S REFREQ=REFREQ+1
- I '$G(REFREQ) W !!,"Number of Refills is required. RxRenewal request cancelled." S DIR(0)="E" D ^DIR K DIR
- ; display information to the user
- W !!,"Sending RxRenewal request for:"
- W !!,"Patient: "_$$GET1^DIQ(52,RXIEN,2,"E")
- W !,"Patient Status: "_$$GET1^DIQ(52,RXIEN,3,"E")
- W !,"Drug: "_$$GET1^DIQ(52,RXIEN,6,"E")
- W !,"Orderable Item: "_$$GET1^DIQ(52,RXIEN,39.2,"E")
- W !,"# of Refills Requested: "_REFREQ,?30,"Days Supply: "_$$GET1^DIQ(52,RXIEN,8,"E"),?52,"Quantity: "_$$GET1^DIQ(52,RXIEN,7,"E")
- W !!,"Would you like to send this RxRenewal request to the prescriber"
- S DIR(0)="YO",DIR("B")="N" D ^DIR K DIR
- I Y<1!(Y=U) S DIR(0)="E" W !!,"RxRenewal Request cancelled! No RxRenewal request will be sent." D ^DIR K DIR Q
- I 'S2017 S GBL=$$RREQ(PSOIEN,RXIEN,ORNUM,PSOSITE,.MESSID,REFREQ) I '$O(@GBL@(0)) W !!,"Could not create outgoing renewal message structure." D DIRE Q
- I S2017 S GBL=$$RENEWREQ^PSOERXOA(PSOIEN,RXIEN,ORNUM,PSOSITE,.MESSID,REFREQ) I '$O(@GBL@(0)) W !!,"Could not create outgoing renewal message structure." D DIRE Q
- S PSSRET=$$RESTPOST^PSOERXO1(.PSSRET,.GBL)
- ; 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 HUBID=$G(PSSRET("outboundMsgId")) I 'HUBID W !,"The eRx Processing hub did not return a Hub identification number." S DIR(0)="E" D ^DIR K DIR Q
- ; vista generated message will be V12345 (V concatenated to the hubId)
- S HUBID="V"_HUBID
- W !!,"Renewal Request sent." S DIR(0)="E" D ^DIR K DIR
- ; Validates if the order is an eRx and Logs Activity in AL eRx for Approved Refill Response Pending Renewal Activity
- D RXACT^PSOBPSU2(RXIEN,,"Electronic RxRenewal Request sent to External Provider","O")
- N RES
- I 'S2017 D
- .S I=0 F S I=$O(@GBL@(I)) Q:'I!($G(SSSTART)) D
- ..I $G(@GBL@(I,0))="<StructuredSIG>" S SSSTART=I Q
- .S I=999999999 F S I=$O(@GBL@(I),-1) Q:'I!$G(SSSTOP) D
- ..I $G(@GBL@(I,0))="</StructuredSIG>" S SSSTOP=I
- .S GBL2=$NA(^TMP("STSIG^PSOERXX1",$J)) K @GBL2
- .I $D(SSSTART),$D(SSSTOP) D
- ..F I=SSSTART:1:SSSTOP D
- ...S @GBL2@(I,0)=@GBL@(I,0) K @GBL@(I,0)
- .; build streams
- .; set BP
- .S I=0 F S I=$O(@GBL@(I)) Q:'I D
- ..S XXL1=$G(XXL1)_$G(@GBL@(I,0))
- .I $D(@GBL2) D
- ..S I=0 F S I=$O(@GBL2@(I)) Q:'I D
- ...S XXL2=$G(XXL2)_$G(@GBL2@(I,0))
- ..S XXL2="<SIG>"_XXL2_"</SIG>"
- .I '$D(XXL2) S XXL2=""
- .S VADAT=DUZ_U_RXIEN
- .S RTHID=$$GET1^DIQ(52.49,PSOIEN,.01,"E")
- .S HUBID=HUBID_U_U_RTHID
- .D INCERX^PSOERXA1(.RES,.XXL1,"","","",STATION,DIV,HUBID,"",.XXL2,VADAT)
- I S2017 D
- .; build stream
- .S I=0 F S I=$O(@GBL@(I)) Q:'I D
- ..S XXL1=$G(XXL1)_$G(@GBL@(I,0))
- .S VADAT=DUZ_U_RXIEN
- .S RTHID=$$GET1^DIQ(52.49,PSOIEN,.01,"E")
- .S HUBID=HUBID_U_U_RTHID
- .D INCERX^PSOERXI1(.RES,.XXL1,"","","",STATION,DIV,HUBID,"","",VADAT,"")
- I $P(RES,U)=0 D
- .W !,"A problem was encountered while trying to file the RxRenewal request."
- .W !,"RxRenewal Request was not filed in vista."
- .W !!,"ERROR: "_$P(RES,U,2)
- .S DIR(0)="E" D ^DIR K DIR
- K @GBL
- Q
- ; CHANGE REQUEST VIA ERX HOLDING QUEUE
- CREQHQ(PSOIEN,PSOSITE) ;
- N ORNUM,RXIEN,DRUG,GBL,DROK,CNT,PSSRET
- Q:'PSOIEN!('PSOSITE)
- S ORNUM=$$GET1^DIQ(52.49,PSOIEN,.12,"I") ;I 'ORNUM W !!,"This order has been Accepted from eRx and cannot be changed." D DIRE Q
- S RXIEN=$O(^PSRX("APL",ORNUM,0)) ;I 'RXIEN W !!,"A current prescription exists for this eRx. Cannot change eRx." D DIRE Q
- ; build drug information into array to be passed into xml builder
- ; for future use
- ; may consider having the user fill in the drug validation screen then issue change request. Or replicate
- ; drug validation section into another 'Change Request' screen.
- S DROK=$$DRGPRMPT(.DRUG) I 'DROK W !!,"Insufficient drug information. Cannot create change request.",!,"Please try again." D DIRE Q
- S GBL=$$CREQ(PSOIEN,.DRUG,PSOSITE,ORNUM,RXIEN) I '$L(GBL) W !!,"Could not create outgoing message structure." D DIRE Q
- S PSSRET=$$RESTPOST^PSOERXO1(.PSSRET,.GBL)
- ; 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
- W !!,"Change Request sent." S DIR(0)="E" D ^DIR K DIR
- K @GBL
- Q
- ; RXFILL MESSAGE
- FMES(PSOIEN) ;
- N ORNUM,RXIEN,DRUG,GBL,FTYPE,PSSRET,CNT
- Q:'PSOIEN
- S ORNUM=$$GET1^DIQ(52.49,PSOIEN,.12,"I") ;I 'ORNUM W !!,"No OE/RR order number. Cannot create rx renewal request." D DIRE Q
- S RXIEN=$O(^PSRX("APL",ORNUM,0)) ;I 'RXIEN W !!,"Could not resolve RX #. Please contact technical support." D DIRE Q
- S NOTE="TESTING NOTE"
- S FTYPE="F"
- S GBL=$$RXFILL(PSOIEN,FTYPE,NOTE,RXIEN,ORNUM) I '$L(GBL) W !!,"Could not create outgoing message structure." D DIRE Q
- S PSSRET=$$RESTPOST^PSOERXO1(.PSSRET,.GBL)
- ; 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
- W !!,"RxFill Message sent." S DIR(0)="E" D ^DIR K DIR
- ; if the message was successful, file the outbound message contents into 52.49
- K @GBL
- Q
- ; prompt for drug fields needed to create a change request - not currently used
- DRGPRMPT(DRG) ;
- ; Prompt for drug
- N DIC,PSODRUG,DIR,Y
- S DIC(0)="AEMQ",DIC=50,DIC("S")="I $$ACTIVE^PSOERXA0(Y),($$OUTPAT^PSOERXA0(Y)),('$$INVCOMP^PSOERXA0(Y))" D ^DIC
- K DIC
- Q:$P(Y,U)<1 0
- S DRG("DRUG")=$P(Y,U,2)
- S PSODRUG("IEN")=$P(Y,U)
- ; prompt for days supply
- K DIR S DIR(0)="52.49,20.2" D ^DIR
- Q:$P(Y,U)<1 0
- S DRG("DSUP")=Y
- ; prompt for quantity
- K DIR S DIR(0)="52.49,20.1" D ^DIR
- Q:$P(Y,U)<1 0
- S DRG("QTY")=Y
- ; prompt for refills
- K DIR S DIR(0)="52.49,20.5" D ^DIR
- Q:$P(Y,U)<1 0
- S DRG("REF")=Y
- ; prompt for directions
- K DIR S DIR(0)="52.49,7" D ^DIR
- Q:Y="^" 0
- Q:Y']"" 0
- S DRG("DIR")=Y
- Q 1
- ; CHANGE REQUEST VIA BACKDOOR ORDERS
- CREQBD(RXIEN) ;
- Q
- ; CHANGE REQUEST VIA PSO LMOE FINISH
- CREQPO(ORIEN) ;
- Q
- RREQ(PSOIEN,RXIEN,ORNUM,PSOSITE,MESSID,REFREQ) ;RefillRequest
- N GBL,PSOIENS,CNT
- Q:'PSOIEN ""
- S GBL=$NA(^TMP("RREQ^PSOERXX1",$J)) K @GBL
- S CNT=0
- D MSG^PSOERXX2(.GBL,1)
- ; header
- S MESSID=$$HDR^PSOERXX2(.GBL,PSOIEN)
- ; body header
- D BHF^PSOERXX2(.GBL,1)
- ; request type header
- D RTYPE^PSOERXX2(.GBL,"RefillRequest",1)
- ; request info - not currently used
- ;D REQUEST^PSOERXX2(.GBL,"ACC","ACC")
- D VAPHARM^PSOERXX2(.GBL,PSOSITE,PSOIEN)
- D PRESCRIB^PSOERXX2(.GBL,PSOSITE,PSOIEN)
- D SUPERVIS^PSOERXX2(.GBL,PSOSITE,PSOIEN)
- D FACIL^PSOERXX2(.GBL,PSOSITE,PSOIEN)
- D PATIENT^PSOERXX3(.GBL,PSOSITE,PSOIEN)
- D MEDPRES^PSOERXX4(.GBL,PSOIEN,REFREQ,REFREQ)
- D MEDDIS^PSOERXX4(.GBL,RXIEN,ORNUM,PSOIEN,REFREQ)
- D OBSERVE^PSOERXX3(.GBL,PSOIEN)
- D BENEFITS^PSOERXX3(.GBL,PSOIEN)
- D DRUGEVAL^PSOERXX3(.GBL,PSOIEN)
- ;D DIAGNOS(.GBL,PSOIEN)
- D RTYPE^PSOERXX2(.GBL,"RefillRequest",2)
- D BHF^PSOERXX2(.GBL,2)
- D MSG^PSOERXX2(.GBL,2)
- Q GBL
- ; PSOIEN - erx IEN from 52.49
- CREQ(PSOIEN,REQDRUG,PSOSITE,ORNUM,RXIEN) ;ChangeRequest
- N GBL,PSOIENS,CNT
- Q:'PSOIEN ""
- S GBL=$NA(^TMP("CREQ^PSOERXX1",$J)) K @GBL
- S CNT=0
- D MSG^PSOERXX2(.GBL,1)
- ; header
- D HDR^PSOERXX2(.GBL,PSOIEN)
- ; body header
- D BHF^PSOERXX2(.GBL,1)
- ; request type header
- D RTYPE^PSOERXX2(.GBL,"RxChangeRequest",1)
- ; request info
- D REQUEST^PSOERXX2(.GBL,"TST","TST")
- D VAPHARM^PSOERXX2(.GBL,PSOSITE,PSOIEN)
- D PRESCRIB^PSOERXX2(.GBL,PSOIEN)
- D SUPERVIS^PSOERXX2(.GBL,PSOIEN)
- D FACIL^PSOERXX2(.GBL,PSOIEN)
- D PATIENT^PSOERXX3(.GBL,PSOIEN)
- D MEDPRES^PSOERXX4(.GBL,PSOIEN)
- D MEDREQ^PSOERXX4(.GBL,PSOIEN,.REQDRUG)
- D OBSERVE^PSOERXX3(.GBL,PSOIEN)
- D BENEFITS^PSOERXX3(.GBL,PSOIEN)
- D DRUGEVAL^PSOERXX3(.GBL,PSOIEN)
- D DIAGNOS^PSOERXX3(.GBL,PSOIEN)
- D RTYPE^PSOERXX2(.GBL,"RxChangeRequest",2)
- D BHF^PSOERXX2(.GBL,2)
- D MSG^PSOERXX2(.GBL,2)
- Q GBL
- ; FP - full or partial fill (F/P)
- ; NOTE - fill notes
- RXFILL(PSOIEN,FP,NOTE,RXIEN,ORNUM) ;
- N GBL,PSOIENS,CNT
- Q:'PSOIEN ""
- S GBL=$NA(^TMP("RXFILL^PSOERXX1",$J)) K @GBL
- S CNT=0
- D MSG^PSOERXX2(.GBL,1)
- ; header
- D HDR^PSOERXX2(.GBL,PSOIEN)
- ; body header
- D BHF^PSOERXX2(.GBL,1)
- ; request type header
- D RTYPE^PSOERXX2(.GBL,"RxFill",1)
- ; request info
- S FP="F"
- S NOTE=$G(NOTE,"TESTING NOTES")
- ; fill status
- D FILLST^PSOERXX3(.GBL,FP,NOTE)
- D VAPHARM^PSOERXX2(.GBL,PSOIEN)
- D PRESCRIB^PSOERXX2(.GBL,PSOIEN)
- D SUPERVIS^PSOERXX2(.GBL,PSOIEN)
- D FACIL^PSOERXX2(.GBL,PSOIEN)
- D PATIENT^PSOERXX3(.GBL,PSOIEN)
- D MEDPRES^PSOERXX4(.GBL,PSOIEN)
- D MEDDIS^PSOERXX4(.GBL,PSOIEN)
- D OBSERVE^PSOERXX3(.GBL,PSOIEN)
- D BENEFITS^PSOERXX3(.GBL,PSOIEN)
- D DRUGEVAL^PSOERXX3(.GBL,PSOIEN)
- ;D DIAGNOS^PSOERXX3(.GBL,PSOIEN)
- D RTYPE^PSOERXX2(.GBL,"RxFill",2)
- D BHF^PSOERXX2(.GBL,2)
- D MSG^PSOERXX2(.GBL,2)
- Q GBL
- DIRE ;
- N DIR S DIR(0)="E" D ^DIR
- Q
- CONVXML(ARYNM) ;
- N F,F2,F3,F4,DATA
- S F=0 F S F=$O(@ARYNM@(F)) Q:F="" D
- .S F2="" F S F2=$O(@ARYNM@(F,F2)) Q:F2="" D
- ..S F3="" F S F3=$O(@ARYNM@(F,F2,F3)) Q:F3="" D
- ...S F4="" F S F4=$O(@ARYNM@(F,F2,F3,F4)) Q:F4="" D
- ....S DATA=$G(@ARYNM@(F,F2,F3,F4))
- ....S DATA=$$SYMENC^MXMLUTL(DATA)
- ....S @ARYNM@(F,F2,F3,F4)=DATA
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSOERXX1 16395 printed Jan 18, 2025@03:30:22 Page 2
- PSOERXX1 ;ALB/BWF - eRx xml utilities ; 8/3/2016 5:14pm
- +1 ;;7.0;OUTPATIENT PHARMACY;**467,520,527,508,581,617**;DEC 1997;Build 110
- +2 ;
- +3 QUIT
- +4 ; called by PSO ERX RX RENEWAL REQUEST action protocol
- RREQLST(PSOLST,PSOSITE,PSOCNT) ;
- +1 NEW ITEM,SEL,ORD,I,ERXIEN,DONE,ORDER,ORDLST,RXIEN,RXDRUG,RXDRUGN,PRECHECK,DIR
- +2 DO FULL^VALM1
- +3 SET DIR("A")="Select Orders by number"
- SET DIR(0)="LO^1:"_PSOCNT
- DO ^DIR
- IF $DATA(DTOUT)!($DATA(DUOUT))
- KILL DIR,DIRUT,DTOUT,DUOUT
- QUIT
- +4 SET ORDLST=Y
- +5 WRITE !!,"NOTE: If you have selected items that are not inbound eRx Prescriptions,"
- +6 WRITE !,"those entries will be skipped during the RxRenewal process.",!!
- +7 KILL DIR
- +8 SET DONE=0
- +9 FOR I=1:1
- Begin DoDot:1
- +10 SET ITEM=$PIECE(ORDLST,",",I)
- IF ITEM=""
- SET DONE=1
- QUIT
- +11 IF $PIECE(PSOLST(ITEM),U)'=52
- WRITE !,"This item is "_$PIECE(PSOLST(ITEM),U,3)_" and cannot be renewed.",!
- DO DIRE
- QUIT
- +12 SET RXIEN=$PIECE(PSOLST(ITEM),U,2)
- +13 SET ORDER=$$GET1^DIQ(52,RXIEN,39.3,"I")
- +14 SET ERXIEN=$$CHKERX^PSOERXU1(ORDER)
- if 'ERXIEN
- QUIT
- +15 SET RXDRUG=$$GET1^DIQ(52,RXIEN,6,"I")
- SET RXDRUGN=$$GET1^DIQ(52,RXIEN,6,"E")
- +16 WRITE !!,"Now renewing prescription #: "_$$GET1^DIQ(52,RXIEN,.01,"E")
- +17 WRITE !,"Patient: "_$$GET1^DIQ(52,RXIEN,2,"E")
- +18 WRITE !,"Drug/Supply: "_RXDRUGN
- +19 WRITE !,"# of Refills: "_$$GET1^DIQ(52,RXIEN,9,"E"),?30,"Days Supply: "_$$GET1^DIQ(52,RXIEN,8,"E"),?52,"Quantity: "_$$GET1^DIQ(52,RXIEN,7,"E")
- +20 SET PRECHECK=$$RENEW^PSORENW(RXIEN,RXDRUG)
- +21 IF $PIECE(PRECHECK,U)<1
- WRITE !,$PIECE(PRECHECK,U,2),!
- DO DIRE
- QUIT
- +22 DO RREQOP(ERXIEN,PSOSITE)
- End DoDot:1
- if DONE
- QUIT
- +23 QUIT
- +24 ; Called by PSO ERX SINGLE RX RENEWAL REQUEST action protocol
- RREQSIN(RXIEN,PSOSITE) ;
- +1 NEW ORDER,ERXIEN,RXDRUG,RXDRUGN,PRECHECK
- +2 SET ORDER=$$GET1^DIQ(52,RXIEN,39.3,"I")
- if 'ORDER
- QUIT
- +3 SET ERXIEN=$$CHKERX^PSOERXU1(ORDER)
- IF 'ERXIEN
- WRITE !!,"RxRenewal request may not be used. This prescription is not an eRx."
- DO DIRE
- QUIT
- +4 SET RXDRUG=$$GET1^DIQ(52,RXIEN,6,"I")
- SET RXDRUGN=$$GET1^DIQ(52,RXIEN,6,"E")
- +5 WRITE !!,"Now renewing prescription #: "_$$GET1^DIQ(52,RXIEN,.01,"E")
- +6 WRITE !,"Patient: "_$$GET1^DIQ(52,RXIEN,2,"E")
- +7 WRITE !,"Drug/Supply: "_RXDRUGN,!!
- +8 WRITE !,"# of Refills: "_$$GET1^DIQ(52,RXIEN,9,"E"),?30,"Days Supply: "_$$GET1^DIQ(52,RXIEN,8,"E"),?52,"Quantity: "_$$GET1^DIQ(52,RXIEN,7,"E")
- +9 SET PRECHECK=$$RENEW^PSORENW(RXIEN,RXDRUG)
- +10 IF $PIECE(PRECHECK,U)<1
- WRITE !,$PIECE(PRECHECK,U,2),!
- QUIT
- +11 DO RREQOP(ERXIEN,PSOSITE)
- +12 QUIT
- +13 ; PSOIEN - ien from 52.49 (erx holding queue)
- +14 ; PSOSITE - site ien from the outpatient site file (59)
- +15 ; RX RENEWAL REQUEST VIA PSO LMOE FINISH/BACKDOOR ORDERS
- RREQOP(PSOIEN,PSOSITE) ;
- +1 NEW ORNUM,RXIEN,PSSOUT,GBL,REFL,I,EXDT,PEND,PSSRET,CNT,DIR,Y,REFQTY,REFREQ,DIV,VADAT,RRCNT
- +2 NEW I,SSSTART,SSSTOP,GBL2,XXL1,XXL2,HUBID,NPIINST,STATION,Y,DIR,DONE,INNAME,NPI,NERXIEN,PROHIBIT1,PROHIBIT
- +3 NEW MSGIEN,MSGDT,RESIEN,SIG,SIGLEN,DTCUT,RTHID,PSORENW,EXPFLG,S2017,MTYPE,RESVAL,REQIEN
- +4 SET VALMBCK="R"
- +5 if 'PSOIEN!('PSOSITE)
- QUIT
- +6 SET MTYPE=$$GET1^DIQ(52.49,PSOIEN,.08,"I")
- +7 IF MTYPE="CX"
- SET NERXIEN=$$FINDNRX^PSOERXU6(PSOIEN)
- +8 IF MTYPE="CX"
- SET PROHIBIT=$$GET1^DIQ(52.49,NERXIEN,301.3,"I")
- +9 IF MTYPE'="CX"
- SET PROHIBIT=$$GET1^DIQ(52.49,PSOIEN,301.3,"I")
- +10 IF PROHIBIT
- WRITE !!,"Renewals are prohibited for this eRx."
- DO DIRE
- QUIT
- +11 SET RESVAL=$$GET1^DIQ(52.49,PSOIEN,52.1,"I")
- +12 SET S2017=$$GET1^DIQ(52.49,PSOIEN,312.1,"I")
- +13 SET NPIINST=$$GET1^DIQ(59,PSOSITE,101,"I")
- +14 SET INNAME=$$NAME^XUAF4(NPIINST)
- +15 SET STATION=$$WHAT^XUAF4(NPIINST,99)
- +16 DO FULL^VALM1
- +17 ; bwf - if the NPI is not coming back from the $$NPI check, we have to pull it from the field
- +18 ; iteself
- +19 SET NPI=$$NPI^XUSNPI("Organization_ID",NPIINST)
- IF $PIECE(NPI,U)<1
- Begin DoDot:1
- +20 SET NPI=$$WHAT^XUAF4(NPIINST,41.99)
- End DoDot:1
- +21 IF '$GET(NPI)
- WRITE !!,"NPI could not be established. Cannot create renewal request."
- DO DIRE
- QUIT
- +22 SET DIV=INNAME_U_NPI
- +23 SET ORNUM=$$GET1^DIQ(52.49,PSOIEN,.12,"I")
- IF 'ORNUM
- WRITE !!,"No OE/RR order number. Cannot create renewal request."
- DO DIRE
- QUIT
- +24 SET PEND=$ORDER(^PS(52.41,"B",ORNUM,0))
- +25 SET RXIEN=$ORDER(^PSRX("APL",ORNUM,0))
- +26 IF PEND
- IF 'RXIEN
- WRITE !!,"RX appears to be in Pending Outpatient Orders, but not yet processed to",!,"backdoor orders."
- DO DIRE
- QUIT
- +27 IF 'PEND
- IF 'RXIEN
- WRITE !!,"Cannot resolve RX#. Please ensure the prescription is in the prescription file."
- DO DIRE
- QUIT
- +28 IF $$GET1^DIQ(52,RXIEN,100,"I")=5
- WRITE !!,"Rx is in suspense, cannot renew prescription."
- DO DIRE
- QUIT
- +29 SET PSORENW("ORX #")=$$GET1^DIQ(52,RXIEN,.01,"E")
- +30 IF $ASCII($EXTRACT(PSORENW("ORX #"),$LENGTH(PSORENW("ORX #"))))'<90
- WRITE !!,"Cannot renew Rx # "_PSORENW("ORX #")_", Max number reached."
- DO DIRE
- QUIT
- +31 SET EXDT=$$GET1^DIQ(52,RXIEN,26,"I")
- +32 IF EXDT<$$FMADD^XLFDT(DT,-120)
- WRITE !!,"Medication has expired, cannot renew prescription."
- DO DIRE
- QUIT
- +33 IF EXDT<DT
- SET EXPFLG=1
- +34 SET REFL=$$GET1^DIQ(52,RXIEN,9,"I")
- SET I=0
- FOR
- SET I=$ORDER(^PSRX(RXIEN,1,I))
- if 'I
- QUIT
- SET REFL=REFL-1
- +35 IF REFL>0
- IF '$GET(EXPFLG)
- WRITE !!,"Refills remaining for this prescription. Cannot create RxRenewal request."
- DO DIRE
- QUIT
- +36 SET (SIG,SIGLEN)=0
- FOR
- SET SIG=$ORDER(^PSRX(RXIEN,"INS1",SIG))
- if 'SIG
- QUIT
- Begin DoDot:1
- +37 SET SIGLEN=$GET(SIGLEN)+$LENGTH(^PSRX(RXIEN,"INS1",SIG,0))
- End DoDot:1
- +38 IF 'S2017
- IF SIGLEN>140
- WRITE !!,"Sig is greater than 140 characters. Cannot create renewal request."
- DO DIRE
- QUIT
- +39 SET (DONE,RRCNT)=0
- SET DTCUT=$$FMADD^XLFDT(DT,-30)
- +40 SET REQIEN=$$GETREQ^PSOERXU2(PSOIEN)
- +41 SET MSGIEN=999999999
- FOR
- SET MSGIEN=$ORDER(^PS(52.49,PSOIEN,201,"B",MSGIEN),-1)
- if 'MSGIEN
- QUIT
- Begin DoDot:1
- +42 IF $$GET1^DIQ(52.49,MSGIEN,.08,"I")'="RR"
- QUIT
- +43 ; if this is a renwal response/replace type, and the record is the related request, quit (dont show this one)
- +44 IF MTYPE="RE"
- IF RESVAL="R"
- IF MSGIEN=REQIEN
- IF $$GET1^DIQ(52.49,REQIEN,.08,"I")="RR"
- QUIT
- +45 SET MSGDT=$$GET1^DIQ(52.49,MSGIEN,.03,"I")
- +46 IF MSGDT<DTCUT
- SET DONE=1
- QUIT
- +47 SET RRCNT=$GET(RRCNT)+1
- +48 SET RESIEN=$$GETRESP^PSOERXU2(MSGIEN)
- +49 WRITE !!,"********************************************************************"
- +50 WRITE !!,"Previous RxRenewal Request Date/Time: "_$$FMTE^XLFDT(MSGDT)
- +51 WRITE !,"RxRenewal Requested by: "_$$GET1^DIQ(52.49,MSGIEN,51.1,"E")
- +52 WRITE !,"# of Refills Requested: "_$$GET1^DIQ(52.49,MSGIEN,51.2,"E")
- +53 IF 'RESIEN
- Begin DoDot:2
- +54 WRITE !!,"***No response received from provider.***",!
- +55 SET DIR(0)="E"
- DO ^DIR
- KILL DIR
- End DoDot:2
- QUIT
- +56 WRITE !!,"RxRenewal response Date/Time: "_$$GET1^DIQ(52.49,RESIEN,.03,"E")
- +57 WRITE !!,"RxRenewal response status: "_$$GET1^DIQ(52.49,RESIEN,1,"E")
- +58 WRITE !!,"********************************************************************"
- End DoDot:1
- +59 IF RRCNT>0
- WRITE !!,"Total Number of RxRenewal requests in the last 30 days: "_RRCNT,!!
- +60 IF RRCNT
- Begin DoDot:1
- +61 KILL DIR
- SET DIR(0)="YO"
- SET DIR("B")="N"
- SET DIR("A")="Are you sure you would like to send ANOTHER RxRenewal request"
- DO ^DIR
- End DoDot:1
- if 'Y
- QUIT
- +62 WRITE !!,"Generating RxRenewal request for Rx #: "_$$GET1^DIQ(52,RXIEN,.01,"E"),!!
- +63 KILL DIR
- SET DIR(0)="SO^R:RENEW WITH PRE-POPULATED VALUE;C:CHANGE # OF REFILLS;E:EXIT"
- +64 SET DIR("?")=" E - Exit"
- +65 SET DIR("?",1)=" R - Request the same # of refills as the original Rx"
- +66 SET DIR("?",2)=" C - Request desired # of refills (0-11)"
- +67 DO ^DIR
- KILL DIR
- +68 IF Y="E"!$DATA(DIRUT)!(Y="^")
- QUIT
- +69 ;Med Dispensed segments when the Qualifier is 'P' ('n' is the original Refill value sent on NEWRX)
- +70 SET REFQTY=$$GET1^DIQ(52,RXIEN,9,"I")
- +71 IF Y="R"
- Begin DoDot:1
- +72 SET REFREQ=REFQTY
- End DoDot:1
- +73 ;Refill with change Quantity (questions to be displayed to the user such as # of refills, Pharmacist Notes and so on)
- +74 SET DONE=0
- +75 IF Y="C"
- Begin DoDot:1
- +76 FOR
- Begin DoDot:2
- +77 SET DIR(0)="NO^0:11"
- SET DIR("A")="Enter # of Refills or '^' to exit"
- DO ^DIR
- KILL DIR
- +78 if Y=""
- QUIT
- +79 IF Y="^"!$DATA(DIRUT)
- SET DONE=1
- QUIT
- +80 SET REFREQ=Y
- End DoDot:2
- if DONE!($GET(REFREQ)'="")
- QUIT
- End DoDot:1
- +81 if DONE=1
- QUIT
- +82 SET REFREQ=REFREQ+1
- +83 IF '$GET(REFREQ)
- WRITE !!,"Number of Refills is required. RxRenewal request cancelled."
- SET DIR(0)="E"
- DO ^DIR
- KILL DIR
- +84 ; display information to the user
- +85 WRITE !!,"Sending RxRenewal request for:"
- +86 WRITE !!,"Patient: "_$$GET1^DIQ(52,RXIEN,2,"E")
- +87 WRITE !,"Patient Status: "_$$GET1^DIQ(52,RXIEN,3,"E")
- +88 WRITE !,"Drug: "_$$GET1^DIQ(52,RXIEN,6,"E")
- +89 WRITE !,"Orderable Item: "_$$GET1^DIQ(52,RXIEN,39.2,"E")
- +90 WRITE !,"# of Refills Requested: "_REFREQ,?30,"Days Supply: "_$$GET1^DIQ(52,RXIEN,8,"E"),?52,"Quantity: "_$$GET1^DIQ(52,RXIEN,7,"E")
- +91 WRITE !!,"Would you like to send this RxRenewal request to the prescriber"
- +92 SET DIR(0)="YO"
- SET DIR("B")="N"
- DO ^DIR
- KILL DIR
- +93 IF Y<1!(Y=U)
- SET DIR(0)="E"
- WRITE !!,"RxRenewal Request cancelled! No RxRenewal request will be sent."
- DO ^DIR
- KILL DIR
- QUIT
- +94 IF 'S2017
- SET GBL=$$RREQ(PSOIEN,RXIEN,ORNUM,PSOSITE,.MESSID,REFREQ)
- IF '$ORDER(@GBL@(0))
- WRITE !!,"Could not create outgoing renewal message structure."
- DO DIRE
- QUIT
- +95 IF S2017
- SET GBL=$$RENEWREQ^PSOERXOA(PSOIEN,RXIEN,ORNUM,PSOSITE,.MESSID,REFREQ)
- IF '$ORDER(@GBL@(0))
- WRITE !!,"Could not create outgoing renewal message structure."
- DO DIRE
- QUIT
- +96 SET PSSRET=$$RESTPOST^PSOERXO1(.PSSRET,.GBL)
- +97 ; if the post was unsuccessful, inform the user and quit.
- +98 IF $PIECE(PSSRET(0),U)<1
- WRITE !,$PIECE(PSSRET(0),U,2)
- SET DIR(0)="E"
- DO ^DIR
- KILL DIR
- QUIT
- +99 IF $DATA(PSSRET("errorMessage"))
- WRITE !,PSSRET("errorMessage")
- SET DIR(0)="E"
- DO ^DIR
- KILL DIR
- QUIT
- +100 SET HUBID=$GET(PSSRET("outboundMsgId"))
- IF 'HUBID
- WRITE !,"The eRx Processing hub did not return a Hub identification number."
- SET DIR(0)="E"
- DO ^DIR
- KILL DIR
- QUIT
- +101 ; vista generated message will be V12345 (V concatenated to the hubId)
- +102 SET HUBID="V"_HUBID
- +103 WRITE !!,"Renewal Request sent."
- SET DIR(0)="E"
- DO ^DIR
- KILL DIR
- +104 ; Validates if the order is an eRx and Logs Activity in AL eRx for Approved Refill Response Pending Renewal Activity
- +105 DO RXACT^PSOBPSU2(RXIEN,,"Electronic RxRenewal Request sent to External Provider","O")
- +106 NEW RES
- +107 IF 'S2017
- Begin DoDot:1
- +108 SET I=0
- FOR
- SET I=$ORDER(@GBL@(I))
- if 'I!($GET(SSSTART))
- QUIT
- Begin DoDot:2
- +109 IF $GET(@GBL@(I,0))="<StructuredSIG>"
- SET SSSTART=I
- QUIT
- End DoDot:2
- +110 SET I=999999999
- FOR
- SET I=$ORDER(@GBL@(I),-1)
- if 'I!$GET(SSSTOP)
- QUIT
- Begin DoDot:2
- +111 IF $GET(@GBL@(I,0))="</StructuredSIG>"
- SET SSSTOP=I
- End DoDot:2
- +112 SET GBL2=$NAME(^TMP("STSIG^PSOERXX1",$JOB))
- KILL @GBL2
- +113 IF $DATA(SSSTART)
- IF $DATA(SSSTOP)
- Begin DoDot:2
- +114 FOR I=SSSTART:1:SSSTOP
- Begin DoDot:3
- +115 SET @GBL2@(I,0)=@GBL@(I,0)
- KILL @GBL@(I,0)
- End DoDot:3
- End DoDot:2
- +116 ; build streams
- +117 ; set BP
- +118 SET I=0
- FOR
- SET I=$ORDER(@GBL@(I))
- if 'I
- QUIT
- Begin DoDot:2
- +119 SET XXL1=$GET(XXL1)_$GET(@GBL@(I,0))
- End DoDot:2
- +120 IF $DATA(@GBL2)
- Begin DoDot:2
- +121 SET I=0
- FOR
- SET I=$ORDER(@GBL2@(I))
- if 'I
- QUIT
- Begin DoDot:3
- +122 SET XXL2=$GET(XXL2)_$GET(@GBL2@(I,0))
- End DoDot:3
- +123 SET XXL2="<SIG>"_XXL2_"</SIG>"
- End DoDot:2
- +124 IF '$DATA(XXL2)
- SET XXL2=""
- +125 SET VADAT=DUZ_U_RXIEN
- +126 SET RTHID=$$GET1^DIQ(52.49,PSOIEN,.01,"E")
- +127 SET HUBID=HUBID_U_U_RTHID
- +128 DO INCERX^PSOERXA1(.RES,.XXL1,"","","",STATION,DIV,HUBID,"",.XXL2,VADAT)
- End DoDot:1
- +129 IF S2017
- Begin DoDot:1
- +130 ; build stream
- +131 SET I=0
- FOR
- SET I=$ORDER(@GBL@(I))
- if 'I
- QUIT
- Begin DoDot:2
- +132 SET XXL1=$GET(XXL1)_$GET(@GBL@(I,0))
- End DoDot:2
- +133 SET VADAT=DUZ_U_RXIEN
- +134 SET RTHID=$$GET1^DIQ(52.49,PSOIEN,.01,"E")
- +135 SET HUBID=HUBID_U_U_RTHID
- +136 DO INCERX^PSOERXI1(.RES,.XXL1,"","","",STATION,DIV,HUBID,"","",VADAT,"")
- End DoDot:1
- +137 IF $PIECE(RES,U)=0
- Begin DoDot:1
- +138 WRITE !,"A problem was encountered while trying to file the RxRenewal request."
- +139 WRITE !,"RxRenewal Request was not filed in vista."
- +140 WRITE !!,"ERROR: "_$PIECE(RES,U,2)
- +141 SET DIR(0)="E"
- DO ^DIR
- KILL DIR
- End DoDot:1
- +142 KILL @GBL
- +143 QUIT
- +144 ; CHANGE REQUEST VIA ERX HOLDING QUEUE
- CREQHQ(PSOIEN,PSOSITE) ;
- +1 NEW ORNUM,RXIEN,DRUG,GBL,DROK,CNT,PSSRET
- +2 if 'PSOIEN!('PSOSITE)
- QUIT
- +3 ;I 'ORNUM W !!,"This order has been Accepted from eRx and cannot be changed." D DIRE Q
- SET ORNUM=$$GET1^DIQ(52.49,PSOIEN,.12,"I")
- +4 ;I 'RXIEN W !!,"A current prescription exists for this eRx. Cannot change eRx." D DIRE Q
- SET RXIEN=$ORDER(^PSRX("APL",ORNUM,0))
- +5 ; build drug information into array to be passed into xml builder
- +6 ; for future use
- +7 ; may consider having the user fill in the drug validation screen then issue change request. Or replicate
- +8 ; drug validation section into another 'Change Request' screen.
- +9 SET DROK=$$DRGPRMPT(.DRUG)
- IF 'DROK
- WRITE !!,"Insufficient drug information. Cannot create change request.",!,"Please try again."
- DO DIRE
- QUIT
- +10 SET GBL=$$CREQ(PSOIEN,.DRUG,PSOSITE,ORNUM,RXIEN)
- IF '$LENGTH(GBL)
- WRITE !!,"Could not create outgoing message structure."
- DO DIRE
- QUIT
- +11 SET PSSRET=$$RESTPOST^PSOERXO1(.PSSRET,.GBL)
- +12 ; if the post was unsuccessful, inform the user and quit.
- +13 IF $PIECE(PSSRET(0),U)<1
- WRITE !,$PIECE(PSSRET(0),U,2)
- SET DIR(0)="E"
- DO ^DIR
- KILL DIR
- QUIT
- +14 IF $DATA(PSSRET("errorMessage"))
- WRITE !,PSSRET("errorMessage")
- SET DIR(0)="E"
- DO ^DIR
- KILL DIR
- QUIT
- +15 WRITE !!,"Change Request sent."
- SET DIR(0)="E"
- DO ^DIR
- KILL DIR
- +16 KILL @GBL
- +17 QUIT
- +18 ; RXFILL MESSAGE
- FMES(PSOIEN) ;
- +1 NEW ORNUM,RXIEN,DRUG,GBL,FTYPE,PSSRET,CNT
- +2 if 'PSOIEN
- QUIT
- +3 ;I 'ORNUM W !!,"No OE/RR order number. Cannot create rx renewal request." D DIRE Q
- SET ORNUM=$$GET1^DIQ(52.49,PSOIEN,.12,"I")
- +4 ;I 'RXIEN W !!,"Could not resolve RX #. Please contact technical support." D DIRE Q
- SET RXIEN=$ORDER(^PSRX("APL",ORNUM,0))
- +5 SET NOTE="TESTING NOTE"
- +6 SET FTYPE="F"
- +7 SET GBL=$$RXFILL(PSOIEN,FTYPE,NOTE,RXIEN,ORNUM)
- IF '$LENGTH(GBL)
- WRITE !!,"Could not create outgoing message structure."
- DO DIRE
- QUIT
- +8 SET PSSRET=$$RESTPOST^PSOERXO1(.PSSRET,.GBL)
- +9 ; if the post was unsuccessful, inform the user and quit.
- +10 IF $PIECE(PSSRET(0),U)<1
- WRITE !,$PIECE(PSSRET(0),U,2)
- SET DIR(0)="E"
- DO ^DIR
- KILL DIR
- QUIT
- +11 IF $DATA(PSSRET("errorMessage"))
- WRITE !,PSSRET("errorMessage")
- SET DIR(0)="E"
- DO ^DIR
- KILL DIR
- QUIT
- +12 WRITE !!,"RxFill Message sent."
- SET DIR(0)="E"
- DO ^DIR
- KILL DIR
- +13 ; if the message was successful, file the outbound message contents into 52.49
- +14 KILL @GBL
- +15 QUIT
- +16 ; prompt for drug fields needed to create a change request - not currently used
- DRGPRMPT(DRG) ;
- +1 ; Prompt for drug
- +2 NEW DIC,PSODRUG,DIR,Y
- +3 SET DIC(0)="AEMQ"
- SET DIC=50
- SET DIC("S")="I $$ACTIVE^PSOERXA0(Y),($$OUTPAT^PSOERXA0(Y)),('$$INVCOMP^PSOERXA0(Y))"
- DO ^DIC
- +4 KILL DIC
- +5 if $PIECE(Y,U)<1
- QUIT 0
- +6 SET DRG("DRUG")=$PIECE(Y,U,2)
- +7 SET PSODRUG("IEN")=$PIECE(Y,U)
- +8 ; prompt for days supply
- +9 KILL DIR
- SET DIR(0)="52.49,20.2"
- DO ^DIR
- +10 if $PIECE(Y,U)<1
- QUIT 0
- +11 SET DRG("DSUP")=Y
- +12 ; prompt for quantity
- +13 KILL DIR
- SET DIR(0)="52.49,20.1"
- DO ^DIR
- +14 if $PIECE(Y,U)<1
- QUIT 0
- +15 SET DRG("QTY")=Y
- +16 ; prompt for refills
- +17 KILL DIR
- SET DIR(0)="52.49,20.5"
- DO ^DIR
- +18 if $PIECE(Y,U)<1
- QUIT 0
- +19 SET DRG("REF")=Y
- +20 ; prompt for directions
- +21 KILL DIR
- SET DIR(0)="52.49,7"
- DO ^DIR
- +22 if Y="^"
- QUIT 0
- +23 if Y']""
- QUIT 0
- +24 SET DRG("DIR")=Y
- +25 QUIT 1
- +26 ; CHANGE REQUEST VIA BACKDOOR ORDERS
- CREQBD(RXIEN) ;
- +1 QUIT
- +2 ; CHANGE REQUEST VIA PSO LMOE FINISH
- CREQPO(ORIEN) ;
- +1 QUIT
- RREQ(PSOIEN,RXIEN,ORNUM,PSOSITE,MESSID,REFREQ) ;RefillRequest
- +1 NEW GBL,PSOIENS,CNT
- +2 if 'PSOIEN
- QUIT ""
- +3 SET GBL=$NAME(^TMP("RREQ^PSOERXX1",$JOB))
- KILL @GBL
- +4 SET CNT=0
- +5 DO MSG^PSOERXX2(.GBL,1)
- +6 ; header
- +7 SET MESSID=$$HDR^PSOERXX2(.GBL,PSOIEN)
- +8 ; body header
- +9 DO BHF^PSOERXX2(.GBL,1)
- +10 ; request type header
- +11 DO RTYPE^PSOERXX2(.GBL,"RefillRequest",1)
- +12 ; request info - not currently used
- +13 ;D REQUEST^PSOERXX2(.GBL,"ACC","ACC")
- +14 DO VAPHARM^PSOERXX2(.GBL,PSOSITE,PSOIEN)
- +15 DO PRESCRIB^PSOERXX2(.GBL,PSOSITE,PSOIEN)
- +16 DO SUPERVIS^PSOERXX2(.GBL,PSOSITE,PSOIEN)
- +17 DO FACIL^PSOERXX2(.GBL,PSOSITE,PSOIEN)
- +18 DO PATIENT^PSOERXX3(.GBL,PSOSITE,PSOIEN)
- +19 DO MEDPRES^PSOERXX4(.GBL,PSOIEN,REFREQ,REFREQ)
- +20 DO MEDDIS^PSOERXX4(.GBL,RXIEN,ORNUM,PSOIEN,REFREQ)
- +21 DO OBSERVE^PSOERXX3(.GBL,PSOIEN)
- +22 DO BENEFITS^PSOERXX3(.GBL,PSOIEN)
- +23 DO DRUGEVAL^PSOERXX3(.GBL,PSOIEN)
- +24 ;D DIAGNOS(.GBL,PSOIEN)
- +25 DO RTYPE^PSOERXX2(.GBL,"RefillRequest",2)
- +26 DO BHF^PSOERXX2(.GBL,2)
- +27 DO MSG^PSOERXX2(.GBL,2)
- +28 QUIT GBL
- +29 ; PSOIEN - erx IEN from 52.49
- CREQ(PSOIEN,REQDRUG,PSOSITE,ORNUM,RXIEN) ;ChangeRequest
- +1 NEW GBL,PSOIENS,CNT
- +2 if 'PSOIEN
- QUIT ""
- +3 SET GBL=$NAME(^TMP("CREQ^PSOERXX1",$JOB))
- KILL @GBL
- +4 SET CNT=0
- +5 DO MSG^PSOERXX2(.GBL,1)
- +6 ; header
- +7 DO HDR^PSOERXX2(.GBL,PSOIEN)
- +8 ; body header
- +9 DO BHF^PSOERXX2(.GBL,1)
- +10 ; request type header
- +11 DO RTYPE^PSOERXX2(.GBL,"RxChangeRequest",1)
- +12 ; request info
- +13 DO REQUEST^PSOERXX2(.GBL,"TST","TST")
- +14 DO VAPHARM^PSOERXX2(.GBL,PSOSITE,PSOIEN)
- +15 DO PRESCRIB^PSOERXX2(.GBL,PSOIEN)
- +16 DO SUPERVIS^PSOERXX2(.GBL,PSOIEN)
- +17 DO FACIL^PSOERXX2(.GBL,PSOIEN)
- +18 DO PATIENT^PSOERXX3(.GBL,PSOIEN)
- +19 DO MEDPRES^PSOERXX4(.GBL,PSOIEN)
- +20 DO MEDREQ^PSOERXX4(.GBL,PSOIEN,.REQDRUG)
- +21 DO OBSERVE^PSOERXX3(.GBL,PSOIEN)
- +22 DO BENEFITS^PSOERXX3(.GBL,PSOIEN)
- +23 DO DRUGEVAL^PSOERXX3(.GBL,PSOIEN)
- +24 DO DIAGNOS^PSOERXX3(.GBL,PSOIEN)
- +25 DO RTYPE^PSOERXX2(.GBL,"RxChangeRequest",2)
- +26 DO BHF^PSOERXX2(.GBL,2)
- +27 DO MSG^PSOERXX2(.GBL,2)
- +28 QUIT GBL
- +29 ; FP - full or partial fill (F/P)
- +30 ; NOTE - fill notes
- RXFILL(PSOIEN,FP,NOTE,RXIEN,ORNUM) ;
- +1 NEW GBL,PSOIENS,CNT
- +2 if 'PSOIEN
- QUIT ""
- +3 SET GBL=$NAME(^TMP("RXFILL^PSOERXX1",$JOB))
- KILL @GBL
- +4 SET CNT=0
- +5 DO MSG^PSOERXX2(.GBL,1)
- +6 ; header
- +7 DO HDR^PSOERXX2(.GBL,PSOIEN)
- +8 ; body header
- +9 DO BHF^PSOERXX2(.GBL,1)
- +10 ; request type header
- +11 DO RTYPE^PSOERXX2(.GBL,"RxFill",1)
- +12 ; request info
- +13 SET FP="F"
- +14 SET NOTE=$GET(NOTE,"TESTING NOTES")
- +15 ; fill status
- +16 DO FILLST^PSOERXX3(.GBL,FP,NOTE)
- +17 DO VAPHARM^PSOERXX2(.GBL,PSOIEN)
- +18 DO PRESCRIB^PSOERXX2(.GBL,PSOIEN)
- +19 DO SUPERVIS^PSOERXX2(.GBL,PSOIEN)
- +20 DO FACIL^PSOERXX2(.GBL,PSOIEN)
- +21 DO PATIENT^PSOERXX3(.GBL,PSOIEN)
- +22 DO MEDPRES^PSOERXX4(.GBL,PSOIEN)
- +23 DO MEDDIS^PSOERXX4(.GBL,PSOIEN)
- +24 DO OBSERVE^PSOERXX3(.GBL,PSOIEN)
- +25 DO BENEFITS^PSOERXX3(.GBL,PSOIEN)
- +26 DO DRUGEVAL^PSOERXX3(.GBL,PSOIEN)
- +27 ;D DIAGNOS^PSOERXX3(.GBL,PSOIEN)
- +28 DO RTYPE^PSOERXX2(.GBL,"RxFill",2)
- +29 DO BHF^PSOERXX2(.GBL,2)
- +30 DO MSG^PSOERXX2(.GBL,2)
- +31 QUIT GBL
- DIRE ;
- +1 NEW DIR
- SET DIR(0)="E"
- DO ^DIR
- +2 QUIT
- CONVXML(ARYNM) ;
- +1 NEW F,F2,F3,F4,DATA
- +2 SET F=0
- FOR
- SET F=$ORDER(@ARYNM@(F))
- if F=""
- QUIT
- Begin DoDot:1
- +3 SET F2=""
- FOR
- SET F2=$ORDER(@ARYNM@(F,F2))
- if F2=""
- QUIT
- Begin DoDot:2
- +4 SET F3=""
- FOR
- SET F3=$ORDER(@ARYNM@(F,F2,F3))
- if F3=""
- QUIT
- Begin DoDot:3
- +5 SET F4=""
- FOR
- SET F4=$ORDER(@ARYNM@(F,F2,F3,F4))
- if F4=""
- QUIT
- Begin DoDot:4
- +6 SET DATA=$GET(@ARYNM@(F,F2,F3,F4))
- +7 SET DATA=$$SYMENC^MXMLUTL(DATA)
- +8 SET @ARYNM@(F,F2,F3,F4)=DATA
- End DoDot:4
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +9 QUIT