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

PSOERXX1.m

Go to the documentation of this file.
  1. 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
  1. ;
  1. Q
  1. ; called by PSO ERX RX RENEWAL REQUEST action protocol
  1. RREQLST(PSOLST,PSOSITE,PSOCNT) ;
  1. N ITEM,SEL,ORD,I,ERXIEN,DONE,ORDER,ORDLST,RXIEN,RXDRUG,RXDRUGN,PRECHECK,DIR
  1. D FULL^VALM1
  1. 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
  1. S ORDLST=Y
  1. W !!,"NOTE: If you have selected items that are not inbound eRx Prescriptions,"
  1. W !,"those entries will be skipped during the RxRenewal process.",!!
  1. K DIR
  1. S DONE=0
  1. F I=1:1 D Q:DONE
  1. .S ITEM=$P(ORDLST,",",I) I ITEM="" S DONE=1 Q
  1. .I $P(PSOLST(ITEM),U)'=52 W !,"This item is "_$P(PSOLST(ITEM),U,3)_" and cannot be renewed.",! D DIRE Q
  1. .S RXIEN=$P(PSOLST(ITEM),U,2)
  1. .S ORDER=$$GET1^DIQ(52,RXIEN,39.3,"I")
  1. .S ERXIEN=$$CHKERX^PSOERXU1(ORDER) Q:'ERXIEN
  1. .S RXDRUG=$$GET1^DIQ(52,RXIEN,6,"I"),RXDRUGN=$$GET1^DIQ(52,RXIEN,6,"E")
  1. .W !!,"Now renewing prescription #: "_$$GET1^DIQ(52,RXIEN,.01,"E")
  1. .W !,"Patient: "_$$GET1^DIQ(52,RXIEN,2,"E")
  1. .W !,"Drug/Supply: "_RXDRUGN
  1. .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")
  1. .S PRECHECK=$$RENEW^PSORENW(RXIEN,RXDRUG)
  1. .I $P(PRECHECK,U)<1 W !,$P(PRECHECK,U,2),! D DIRE Q
  1. .D RREQOP(ERXIEN,PSOSITE)
  1. Q
  1. ; Called by PSO ERX SINGLE RX RENEWAL REQUEST action protocol
  1. RREQSIN(RXIEN,PSOSITE) ;
  1. N ORDER,ERXIEN,RXDRUG,RXDRUGN,PRECHECK
  1. S ORDER=$$GET1^DIQ(52,RXIEN,39.3,"I") Q:'ORDER
  1. S ERXIEN=$$CHKERX^PSOERXU1(ORDER) I 'ERXIEN W !!,"RxRenewal request may not be used. This prescription is not an eRx." D DIRE Q
  1. S RXDRUG=$$GET1^DIQ(52,RXIEN,6,"I"),RXDRUGN=$$GET1^DIQ(52,RXIEN,6,"E")
  1. W !!,"Now renewing prescription #: "_$$GET1^DIQ(52,RXIEN,.01,"E")
  1. W !,"Patient: "_$$GET1^DIQ(52,RXIEN,2,"E")
  1. W !,"Drug/Supply: "_RXDRUGN,!!
  1. 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")
  1. S PRECHECK=$$RENEW^PSORENW(RXIEN,RXDRUG)
  1. I $P(PRECHECK,U)<1 W !,$P(PRECHECK,U,2),! Q
  1. D RREQOP(ERXIEN,PSOSITE)
  1. Q
  1. ; PSOIEN - ien from 52.49 (erx holding queue)
  1. ; PSOSITE - site ien from the outpatient site file (59)
  1. ; RX RENEWAL REQUEST VIA PSO LMOE FINISH/BACKDOOR ORDERS
  1. RREQOP(PSOIEN,PSOSITE) ;
  1. N ORNUM,RXIEN,PSSOUT,GBL,REFL,I,EXDT,PEND,PSSRET,CNT,DIR,Y,REFQTY,REFREQ,DIV,VADAT,RRCNT
  1. N I,SSSTART,SSSTOP,GBL2,XXL1,XXL2,HUBID,NPIINST,STATION,Y,DIR,DONE,INNAME,NPI,NERXIEN,PROHIBIT1,PROHIBIT
  1. N MSGIEN,MSGDT,RESIEN,SIG,SIGLEN,DTCUT,RTHID,PSORENW,EXPFLG,S2017,MTYPE,RESVAL,REQIEN
  1. S VALMBCK="R"
  1. Q:'PSOIEN!('PSOSITE)
  1. S MTYPE=$$GET1^DIQ(52.49,PSOIEN,.08,"I")
  1. I MTYPE="CX" S NERXIEN=$$FINDNRX^PSOERXU6(PSOIEN)
  1. I MTYPE="CX" S PROHIBIT=$$GET1^DIQ(52.49,NERXIEN,301.3,"I")
  1. I MTYPE'="CX" S PROHIBIT=$$GET1^DIQ(52.49,PSOIEN,301.3,"I")
  1. I PROHIBIT W !!,"Renewals are prohibited for this eRx." D DIRE Q
  1. S RESVAL=$$GET1^DIQ(52.49,PSOIEN,52.1,"I")
  1. S S2017=$$GET1^DIQ(52.49,PSOIEN,312.1,"I")
  1. S NPIINST=$$GET1^DIQ(59,PSOSITE,101,"I")
  1. S INNAME=$$NAME^XUAF4(NPIINST)
  1. S STATION=$$WHAT^XUAF4(NPIINST,99)
  1. D FULL^VALM1
  1. ; bwf - if the NPI is not coming back from the $$NPI check, we have to pull it from the field
  1. ; iteself
  1. S NPI=$$NPI^XUSNPI("Organization_ID",NPIINST) I $P(NPI,U)<1 D
  1. .S NPI=$$WHAT^XUAF4(NPIINST,41.99)
  1. I '$G(NPI) W !!,"NPI could not be established. Cannot create renewal request." D DIRE Q
  1. S DIV=INNAME_U_NPI
  1. S ORNUM=$$GET1^DIQ(52.49,PSOIEN,.12,"I") I 'ORNUM W !!,"No OE/RR order number. Cannot create renewal request." D DIRE Q
  1. S PEND=$O(^PS(52.41,"B",ORNUM,0))
  1. S RXIEN=$O(^PSRX("APL",ORNUM,0))
  1. I PEND,'RXIEN W !!,"RX appears to be in Pending Outpatient Orders, but not yet processed to",!,"backdoor orders." D DIRE Q
  1. I 'PEND,'RXIEN W !!,"Cannot resolve RX#. Please ensure the prescription is in the prescription file." D DIRE Q
  1. I $$GET1^DIQ(52,RXIEN,100,"I")=5 W !!,"Rx is in suspense, cannot renew prescription." D DIRE Q
  1. S PSORENW("ORX #")=$$GET1^DIQ(52,RXIEN,.01,"E")
  1. I $A($E(PSORENW("ORX #"),$L(PSORENW("ORX #"))))'<90 W !!,"Cannot renew Rx # "_PSORENW("ORX #")_", Max number reached." D DIRE Q
  1. S EXDT=$$GET1^DIQ(52,RXIEN,26,"I")
  1. I EXDT<$$FMADD^XLFDT(DT,-120) W !!,"Medication has expired, cannot renew prescription." D DIRE Q
  1. I EXDT<DT S EXPFLG=1
  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
  1. I REFL>0,'$G(EXPFLG) W !!,"Refills remaining for this prescription. Cannot create RxRenewal request." D DIRE Q
  1. S (SIG,SIGLEN)=0 F S SIG=$O(^PSRX(RXIEN,"INS1",SIG)) Q:'SIG D
  1. .S SIGLEN=$G(SIGLEN)+$L(^PSRX(RXIEN,"INS1",SIG,0))
  1. I 'S2017,SIGLEN>140 W !!,"Sig is greater than 140 characters. Cannot create renewal request." D DIRE Q
  1. S (DONE,RRCNT)=0,DTCUT=$$FMADD^XLFDT(DT,-30)
  1. S REQIEN=$$GETREQ^PSOERXU2(PSOIEN)
  1. S MSGIEN=999999999 F S MSGIEN=$O(^PS(52.49,PSOIEN,201,"B",MSGIEN),-1) Q:'MSGIEN D
  1. .I $$GET1^DIQ(52.49,MSGIEN,.08,"I")'="RR" Q
  1. .; if this is a renwal response/replace type, and the record is the related request, quit (dont show this one)
  1. .I MTYPE="RE",RESVAL="R",MSGIEN=REQIEN,$$GET1^DIQ(52.49,REQIEN,.08,"I")="RR" Q
  1. .S MSGDT=$$GET1^DIQ(52.49,MSGIEN,.03,"I")
  1. .I MSGDT<DTCUT S DONE=1 Q
  1. .S RRCNT=$G(RRCNT)+1
  1. .S RESIEN=$$GETRESP^PSOERXU2(MSGIEN)
  1. .W !!,"********************************************************************"
  1. .W !!,"Previous RxRenewal Request Date/Time: "_$$FMTE^XLFDT(MSGDT)
  1. .W !,"RxRenewal Requested by: "_$$GET1^DIQ(52.49,MSGIEN,51.1,"E")
  1. .W !,"# of Refills Requested: "_$$GET1^DIQ(52.49,MSGIEN,51.2,"E")
  1. .I 'RESIEN D Q
  1. ..W !!,"***No response received from provider.***",!
  1. ..S DIR(0)="E" D ^DIR K DIR
  1. .W !!,"RxRenewal response Date/Time: "_$$GET1^DIQ(52.49,RESIEN,.03,"E")
  1. .W !!,"RxRenewal response status: "_$$GET1^DIQ(52.49,RESIEN,1,"E")
  1. .W !!,"********************************************************************"
  1. I RRCNT>0 W !!,"Total Number of RxRenewal requests in the last 30 days: "_RRCNT,!!
  1. I RRCNT D Q:'Y
  1. .K DIR S DIR(0)="YO",DIR("B")="N",DIR("A")="Are you sure you would like to send ANOTHER RxRenewal request" D ^DIR
  1. W !!,"Generating RxRenewal request for Rx #: "_$$GET1^DIQ(52,RXIEN,.01,"E"),!!
  1. K DIR S DIR(0)="SO^R:RENEW WITH PRE-POPULATED VALUE;C:CHANGE # OF REFILLS;E:EXIT"
  1. S DIR("?")=" E - Exit"
  1. S DIR("?",1)=" R - Request the same # of refills as the original Rx"
  1. S DIR("?",2)=" C - Request desired # of refills (0-11)"
  1. D ^DIR K DIR
  1. I Y="E"!$D(DIRUT)!(Y="^") Q
  1. ;Med Dispensed segments when the Qualifier is 'P' ('n' is the original Refill value sent on NEWRX)
  1. S REFQTY=$$GET1^DIQ(52,RXIEN,9,"I")
  1. I Y="R" D
  1. .S REFREQ=REFQTY
  1. ;Refill with change Quantity (questions to be displayed to the user such as # of refills, Pharmacist Notes and so on)
  1. S DONE=0
  1. I Y="C" D
  1. .F D Q:DONE!($G(REFREQ)'="")
  1. ..S DIR(0)="NO^0:11",DIR("A")="Enter # of Refills or '^' to exit" D ^DIR K DIR
  1. ..Q:Y=""
  1. ..I Y="^"!$D(DIRUT) S DONE=1 Q
  1. ..S REFREQ=Y
  1. Q:DONE=1
  1. S REFREQ=REFREQ+1
  1. I '$G(REFREQ) W !!,"Number of Refills is required. RxRenewal request cancelled." S DIR(0)="E" D ^DIR K DIR
  1. ; display information to the user
  1. W !!,"Sending RxRenewal request for:"
  1. W !!,"Patient: "_$$GET1^DIQ(52,RXIEN,2,"E")
  1. W !,"Patient Status: "_$$GET1^DIQ(52,RXIEN,3,"E")
  1. W !,"Drug: "_$$GET1^DIQ(52,RXIEN,6,"E")
  1. W !,"Orderable Item: "_$$GET1^DIQ(52,RXIEN,39.2,"E")
  1. W !,"# of Refills Requested: "_REFREQ,?30,"Days Supply: "_$$GET1^DIQ(52,RXIEN,8,"E"),?52,"Quantity: "_$$GET1^DIQ(52,RXIEN,7,"E")
  1. W !!,"Would you like to send this RxRenewal request to the prescriber"
  1. S DIR(0)="YO",DIR("B")="N" D ^DIR K DIR
  1. I Y<1!(Y=U) S DIR(0)="E" W !!,"RxRenewal Request cancelled! No RxRenewal request will be sent." D ^DIR K DIR Q
  1. 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
  1. 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
  1. S PSSRET=$$RESTPOST^PSOERXO1(.PSSRET,.GBL)
  1. ; if the post was unsuccessful, inform the user and quit.
  1. I $P(PSSRET(0),U)<1 W !,$P(PSSRET(0),U,2) S DIR(0)="E" D ^DIR K DIR Q
  1. I $D(PSSRET("errorMessage")) W !,PSSRET("errorMessage") S DIR(0)="E" D ^DIR K DIR Q
  1. 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
  1. ; vista generated message will be V12345 (V concatenated to the hubId)
  1. S HUBID="V"_HUBID
  1. W !!,"Renewal Request sent." S DIR(0)="E" D ^DIR K DIR
  1. ; Validates if the order is an eRx and Logs Activity in AL eRx for Approved Refill Response Pending Renewal Activity
  1. D RXACT^PSOBPSU2(RXIEN,,"Electronic RxRenewal Request sent to External Provider","O")
  1. N RES
  1. I 'S2017 D
  1. .S I=0 F S I=$O(@GBL@(I)) Q:'I!($G(SSSTART)) D
  1. ..I $G(@GBL@(I,0))="<StructuredSIG>" S SSSTART=I Q
  1. .S I=999999999 F S I=$O(@GBL@(I),-1) Q:'I!$G(SSSTOP) D
  1. ..I $G(@GBL@(I,0))="</StructuredSIG>" S SSSTOP=I
  1. .S GBL2=$NA(^TMP("STSIG^PSOERXX1",$J)) K @GBL2
  1. .I $D(SSSTART),$D(SSSTOP) D
  1. ..F I=SSSTART:1:SSSTOP D
  1. ...S @GBL2@(I,0)=@GBL@(I,0) K @GBL@(I,0)
  1. .; build streams
  1. .; set BP
  1. .S I=0 F S I=$O(@GBL@(I)) Q:'I D
  1. ..S XXL1=$G(XXL1)_$G(@GBL@(I,0))
  1. .I $D(@GBL2) D
  1. ..S I=0 F S I=$O(@GBL2@(I)) Q:'I D
  1. ...S XXL2=$G(XXL2)_$G(@GBL2@(I,0))
  1. ..S XXL2="<SIG>"_XXL2_"</SIG>"
  1. .I '$D(XXL2) S XXL2=""
  1. .S VADAT=DUZ_U_RXIEN
  1. .S RTHID=$$GET1^DIQ(52.49,PSOIEN,.01,"E")
  1. .S HUBID=HUBID_U_U_RTHID
  1. .D INCERX^PSOERXA1(.RES,.XXL1,"","","",STATION,DIV,HUBID,"",.XXL2,VADAT)
  1. I S2017 D
  1. .; build stream
  1. .S I=0 F S I=$O(@GBL@(I)) Q:'I D
  1. ..S XXL1=$G(XXL1)_$G(@GBL@(I,0))
  1. .S VADAT=DUZ_U_RXIEN
  1. .S RTHID=$$GET1^DIQ(52.49,PSOIEN,.01,"E")
  1. .S HUBID=HUBID_U_U_RTHID
  1. .D INCERX^PSOERXI1(.RES,.XXL1,"","","",STATION,DIV,HUBID,"","",VADAT,"")
  1. I $P(RES,U)=0 D
  1. .W !,"A problem was encountered while trying to file the RxRenewal request."
  1. .W !,"RxRenewal Request was not filed in vista."
  1. .W !!,"ERROR: "_$P(RES,U,2)
  1. .S DIR(0)="E" D ^DIR K DIR
  1. K @GBL
  1. Q
  1. ; CHANGE REQUEST VIA ERX HOLDING QUEUE
  1. CREQHQ(PSOIEN,PSOSITE) ;
  1. N ORNUM,RXIEN,DRUG,GBL,DROK,CNT,PSSRET
  1. Q:'PSOIEN!('PSOSITE)
  1. 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
  1. S RXIEN=$O(^PSRX("APL",ORNUM,0)) ;I 'RXIEN W !!,"A current prescription exists for this eRx. Cannot change eRx." D DIRE Q
  1. ; build drug information into array to be passed into xml builder
  1. ; for future use
  1. ; may consider having the user fill in the drug validation screen then issue change request. Or replicate
  1. ; drug validation section into another 'Change Request' screen.
  1. S DROK=$$DRGPRMPT(.DRUG) I 'DROK W !!,"Insufficient drug information. Cannot create change request.",!,"Please try again." D DIRE Q
  1. S GBL=$$CREQ(PSOIEN,.DRUG,PSOSITE,ORNUM,RXIEN) I '$L(GBL) W !!,"Could not create outgoing message structure." D DIRE Q
  1. S PSSRET=$$RESTPOST^PSOERXO1(.PSSRET,.GBL)
  1. ; if the post was unsuccessful, inform the user and quit.
  1. I $P(PSSRET(0),U)<1 W !,$P(PSSRET(0),U,2) S DIR(0)="E" D ^DIR K DIR Q
  1. I $D(PSSRET("errorMessage")) W !,PSSRET("errorMessage") S DIR(0)="E" D ^DIR K DIR Q
  1. W !!,"Change Request sent." S DIR(0)="E" D ^DIR K DIR
  1. K @GBL
  1. Q
  1. ; RXFILL MESSAGE
  1. FMES(PSOIEN) ;
  1. N ORNUM,RXIEN,DRUG,GBL,FTYPE,PSSRET,CNT
  1. Q:'PSOIEN
  1. 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
  1. S RXIEN=$O(^PSRX("APL",ORNUM,0)) ;I 'RXIEN W !!,"Could not resolve RX #. Please contact technical support." D DIRE Q
  1. S NOTE="TESTING NOTE"
  1. S FTYPE="F"
  1. S GBL=$$RXFILL(PSOIEN,FTYPE,NOTE,RXIEN,ORNUM) I '$L(GBL) W !!,"Could not create outgoing message structure." D DIRE Q
  1. S PSSRET=$$RESTPOST^PSOERXO1(.PSSRET,.GBL)
  1. ; if the post was unsuccessful, inform the user and quit.
  1. I $P(PSSRET(0),U)<1 W !,$P(PSSRET(0),U,2) S DIR(0)="E" D ^DIR K DIR Q
  1. I $D(PSSRET("errorMessage")) W !,PSSRET("errorMessage") S DIR(0)="E" D ^DIR K DIR Q
  1. W !!,"RxFill Message sent." S DIR(0)="E" D ^DIR K DIR
  1. ; if the message was successful, file the outbound message contents into 52.49
  1. K @GBL
  1. Q
  1. ; prompt for drug fields needed to create a change request - not currently used
  1. DRGPRMPT(DRG) ;
  1. ; Prompt for drug
  1. N DIC,PSODRUG,DIR,Y
  1. S DIC(0)="AEMQ",DIC=50,DIC("S")="I $$ACTIVE^PSOERXA0(Y),($$OUTPAT^PSOERXA0(Y)),('$$INVCOMP^PSOERXA0(Y))" D ^DIC
  1. K DIC
  1. Q:$P(Y,U)<1 0
  1. S DRG("DRUG")=$P(Y,U,2)
  1. S PSODRUG("IEN")=$P(Y,U)
  1. ; prompt for days supply
  1. K DIR S DIR(0)="52.49,20.2" D ^DIR
  1. Q:$P(Y,U)<1 0
  1. S DRG("DSUP")=Y
  1. ; prompt for quantity
  1. K DIR S DIR(0)="52.49,20.1" D ^DIR
  1. Q:$P(Y,U)<1 0
  1. S DRG("QTY")=Y
  1. ; prompt for refills
  1. K DIR S DIR(0)="52.49,20.5" D ^DIR
  1. Q:$P(Y,U)<1 0
  1. S DRG("REF")=Y
  1. ; prompt for directions
  1. K DIR S DIR(0)="52.49,7" D ^DIR
  1. Q:Y="^" 0
  1. Q:Y']"" 0
  1. S DRG("DIR")=Y
  1. Q 1
  1. ; CHANGE REQUEST VIA BACKDOOR ORDERS
  1. CREQBD(RXIEN) ;
  1. Q
  1. ; CHANGE REQUEST VIA PSO LMOE FINISH
  1. CREQPO(ORIEN) ;
  1. Q
  1. RREQ(PSOIEN,RXIEN,ORNUM,PSOSITE,MESSID,REFREQ) ;RefillRequest
  1. N GBL,PSOIENS,CNT
  1. Q:'PSOIEN ""
  1. S GBL=$NA(^TMP("RREQ^PSOERXX1",$J)) K @GBL
  1. S CNT=0
  1. D MSG^PSOERXX2(.GBL,1)
  1. ; header
  1. S MESSID=$$HDR^PSOERXX2(.GBL,PSOIEN)
  1. ; body header
  1. D BHF^PSOERXX2(.GBL,1)
  1. ; request type header
  1. D RTYPE^PSOERXX2(.GBL,"RefillRequest",1)
  1. ; request info - not currently used
  1. ;D REQUEST^PSOERXX2(.GBL,"ACC","ACC")
  1. D VAPHARM^PSOERXX2(.GBL,PSOSITE,PSOIEN)
  1. D PRESCRIB^PSOERXX2(.GBL,PSOSITE,PSOIEN)
  1. D SUPERVIS^PSOERXX2(.GBL,PSOSITE,PSOIEN)
  1. D FACIL^PSOERXX2(.GBL,PSOSITE,PSOIEN)
  1. D PATIENT^PSOERXX3(.GBL,PSOSITE,PSOIEN)
  1. D MEDPRES^PSOERXX4(.GBL,PSOIEN,REFREQ,REFREQ)
  1. D MEDDIS^PSOERXX4(.GBL,RXIEN,ORNUM,PSOIEN,REFREQ)
  1. D OBSERVE^PSOERXX3(.GBL,PSOIEN)
  1. D BENEFITS^PSOERXX3(.GBL,PSOIEN)
  1. D DRUGEVAL^PSOERXX3(.GBL,PSOIEN)
  1. ;D DIAGNOS(.GBL,PSOIEN)
  1. D RTYPE^PSOERXX2(.GBL,"RefillRequest",2)
  1. D BHF^PSOERXX2(.GBL,2)
  1. D MSG^PSOERXX2(.GBL,2)
  1. Q GBL
  1. ; PSOIEN - erx IEN from 52.49
  1. CREQ(PSOIEN,REQDRUG,PSOSITE,ORNUM,RXIEN) ;ChangeRequest
  1. N GBL,PSOIENS,CNT
  1. Q:'PSOIEN ""
  1. S GBL=$NA(^TMP("CREQ^PSOERXX1",$J)) K @GBL
  1. S CNT=0
  1. D MSG^PSOERXX2(.GBL,1)
  1. ; header
  1. D HDR^PSOERXX2(.GBL,PSOIEN)
  1. ; body header
  1. D BHF^PSOERXX2(.GBL,1)
  1. ; request type header
  1. D RTYPE^PSOERXX2(.GBL,"RxChangeRequest",1)
  1. ; request info
  1. D REQUEST^PSOERXX2(.GBL,"TST","TST")
  1. D VAPHARM^PSOERXX2(.GBL,PSOSITE,PSOIEN)
  1. D PRESCRIB^PSOERXX2(.GBL,PSOIEN)
  1. D SUPERVIS^PSOERXX2(.GBL,PSOIEN)
  1. D FACIL^PSOERXX2(.GBL,PSOIEN)
  1. D PATIENT^PSOERXX3(.GBL,PSOIEN)
  1. D MEDPRES^PSOERXX4(.GBL,PSOIEN)
  1. D MEDREQ^PSOERXX4(.GBL,PSOIEN,.REQDRUG)
  1. D OBSERVE^PSOERXX3(.GBL,PSOIEN)
  1. D BENEFITS^PSOERXX3(.GBL,PSOIEN)
  1. D DRUGEVAL^PSOERXX3(.GBL,PSOIEN)
  1. D DIAGNOS^PSOERXX3(.GBL,PSOIEN)
  1. D RTYPE^PSOERXX2(.GBL,"RxChangeRequest",2)
  1. D BHF^PSOERXX2(.GBL,2)
  1. D MSG^PSOERXX2(.GBL,2)
  1. Q GBL
  1. ; FP - full or partial fill (F/P)
  1. ; NOTE - fill notes
  1. RXFILL(PSOIEN,FP,NOTE,RXIEN,ORNUM) ;
  1. N GBL,PSOIENS,CNT
  1. Q:'PSOIEN ""
  1. S GBL=$NA(^TMP("RXFILL^PSOERXX1",$J)) K @GBL
  1. S CNT=0
  1. D MSG^PSOERXX2(.GBL,1)
  1. ; header
  1. D HDR^PSOERXX2(.GBL,PSOIEN)
  1. ; body header
  1. D BHF^PSOERXX2(.GBL,1)
  1. ; request type header
  1. D RTYPE^PSOERXX2(.GBL,"RxFill",1)
  1. ; request info
  1. S FP="F"
  1. S NOTE=$G(NOTE,"TESTING NOTES")
  1. ; fill status
  1. D FILLST^PSOERXX3(.GBL,FP,NOTE)
  1. D VAPHARM^PSOERXX2(.GBL,PSOIEN)
  1. D PRESCRIB^PSOERXX2(.GBL,PSOIEN)
  1. D SUPERVIS^PSOERXX2(.GBL,PSOIEN)
  1. D FACIL^PSOERXX2(.GBL,PSOIEN)
  1. D PATIENT^PSOERXX3(.GBL,PSOIEN)
  1. D MEDPRES^PSOERXX4(.GBL,PSOIEN)
  1. D MEDDIS^PSOERXX4(.GBL,PSOIEN)
  1. D OBSERVE^PSOERXX3(.GBL,PSOIEN)
  1. D BENEFITS^PSOERXX3(.GBL,PSOIEN)
  1. D DRUGEVAL^PSOERXX3(.GBL,PSOIEN)
  1. ;D DIAGNOS^PSOERXX3(.GBL,PSOIEN)
  1. D RTYPE^PSOERXX2(.GBL,"RxFill",2)
  1. D BHF^PSOERXX2(.GBL,2)
  1. D MSG^PSOERXX2(.GBL,2)
  1. Q GBL
  1. DIRE ;
  1. N DIR S DIR(0)="E" D ^DIR
  1. Q
  1. CONVXML(ARYNM) ;
  1. N F,F2,F3,F4,DATA
  1. S F=0 F S F=$O(@ARYNM@(F)) Q:F="" D
  1. .S F2="" F S F2=$O(@ARYNM@(F,F2)) Q:F2="" D
  1. ..S F3="" F S F3=$O(@ARYNM@(F,F2,F3)) Q:F3="" D
  1. ...S F4="" F S F4=$O(@ARYNM@(F,F2,F3,F4)) Q:F4="" D
  1. ....S DATA=$G(@ARYNM@(F,F2,F3,F4))
  1. ....S DATA=$$SYMENC^MXMLUTL(DATA)
  1. ....S @ARYNM@(F,F2,F3,F4)=DATA
  1. Q