APSPESG ;IHS/MSC/MGH - Process entries from APSP REFILL REQUEST file ;24-Jul-2013 08:40;PLS
;;7.0;IHS PHARMACY MODIFICATIONS;**1016**;Sep 23,2004;Build 74
;==================================================================
;RPC calls for refill request component
;Input: FILTER - string containing status values
; TCHK - Flag indicating type of date check
; 0 - no date check (default)
; 1 - Message Date
; 2 - Last Updated Date ( used for denied entries)
; START - Start date (earliest date)
; STOP - Stop date (most recent date)
GETLIST(RET,FILTER,TCHK,START,STOP) ; -- Return list of unprocessed refills
N IEN,CNT
S RET=$$TMPGBL()
S FILTER=$G(FILTER,"0146")
S (IEN,CNT)=0 F S IEN=$O(^APSPRREQ(IEN)) Q:'IEN D
.; do not display if the status is 'processed', there is an OERR order number, or the HL7 data is misisng
.;I $P(^APSPRREQ(IEN,0),U,2)!('$O(^APSPRREQ(IEN,5,0))) Q
.Q:'$$CANSHOW(IEN,FILTER)
.Q:'$$MATCHDT(IEN,TCHK,START,STOP)
.S CNT=CNT+1
.S @RET@(CNT)=$$GETITM(IEN)
Q
; Return string containing data for a single item
GETITM(IEN) ;EP-
;Array will include IEN [1] ^ MESSAGE ID;STATUS [2] ^ IEN;PATIENT NAME (DOB)[3] ^ DRUG NAME[4] ^ DATE [5] ^ PHARMACY [6] ^ PHARMACY ZIP [7] ^
; PROVIDER ID (IEN;NAME) [8] ^ LOCATION ID (IEN;NAME) [9] ^
;IEN_U_MSGID_";"_IND_U_PATNAME_U_DRUG_U_ITMDATE_U_PHARMNM_U_PHARMZIP_U_PRVID_U_LOCID
N LINE,MSGID,SEG,HLDATA,APSPMSH,APSPPID,APSPORC,APSPRX0,APSPRXE,DRUG,PAT,PATLN,PATFN,LINEVAR,ITMDATE
N PATNAME,STAT,PIEN,PNAM,PPHN,PADDR,IND,PTID,PRVID,PTPHN,DNYDT,DNYDTF,DNYUSR,DNYRSN,MATCH
S STAT=+$$GET1^DIQ(9009033.91,IEN,.03,"I")
S MSGID=$$GET1^DIQ(9009033.91,IEN,.01,"E"),HLMSG=$$GHLDAT(IEN)
D SHLVARS
S PATNAME=$$PATNAME(APSPPID) ; From HL7 Message content
S PTPHN=$$GETPPHN(IEN)
S DRUG=$$DRGNAME(APSPRXO)
S ITMDATE=$$GET1^DIQ(9009033.91,IEN,.04,"I")
S ITMDTFMT=$$FMTE^XLFDT(ITMDATE,"5Z")
S ITMDTFMT=$TR(ITMDTFMT,"@"," ")
S (DNYDT,DNYDTF,DNYUSR,DNYRSN)=""
I STAT=3!(STAT=5) D
.S DNYDT=$$GET1^DIQ(9009033.91,IEN,.07,"I")
.S DNYDTF=$$FMTE^XLFDT(DNYDT,"5Z")
.S DNYDTF=$TR(DNYDTF,"@"," ")
.S DNYUSR=$$GET1^DIQ(9009033.91,IEN,.09)
.S DNYRSN=$$GET1^DIQ(9009033.91,IEN,4)
S PIEN=$$GET1^DIQ(9009033.91,IEN,1.7,"I")
S PNAM=$$GET1^DIQ(9009033.9,PIEN,.01)
S PPHN=$$FMTPHN^APSPES2($$GET1^DIQ(9009033.9,PIEN,2.1)) ;Pharmacy Phone
S PFAX=$$FMTPHN^APSPES2($$GET1^DIQ(9009033.9,PIEN,2.2)) ;Pharmacy Fax
S PADD=$$PADDR^APSPESG1(PIEN)
S IND=$S(STAT=6:5,STAT=4:4,STAT=1:13,1:3)
S PTID=$$GET1^DIQ(9009033.91,IEN,1.2,"I")_";"_$$GET1^DIQ(9009033.91,IEN,1.2)
S PRVID=$$GET1^DIQ(9009033.91,IEN,1.3,"I")_";"_$$GET1^DIQ(9009033.91,IEN,1.3)
S LOCID=$$GET1^DIQ(9009033.91,IEN,1.6,"I")_";"_$$GET1^DIQ(9009033.91,IEN,1.6)
S MATCH=$$GET1^DIQ(9009033.91,IEN,.11)
S ORDINFO=$$ORD(IEN) ;Order details D:30 QTY:30 RF:2 DAW:No Indication: 401.9
S NTPHM=$$GET1^DIQ(9009033.91,IEN,4.1) ;Notes to Pharmacist
Q IEN_U_MSGID_";"_IND_U_PATNAME_U_DRUG_U_ITMDATE_";"_ITMDTFMT_U_PIEN_";"_PNAM_U_PPHN_";"_PFAX_U_PTID_U_PRVID_U_LOCID_U_$$GETSIG(IEN)_U_PTPHN_U_PADD_U_DNYDT_";"_DNYDTF_U_DNYUSR_U_DNYRSN_U_MATCH_U_ORDINFO_U_NTPHM_U_$$GMATCHI(IEN)
;TODO - REFILL REQUEST DENIED;ACTIVITY ACTION USER;DENY REASON
;
SHLVARS ; Set up HL segment data
N SEGTYP,VAR
F SEGTYP="MSH","PID","ORC","RXO","RXE","RXR","RXD","DG1" S VAR="APSP"_SEGTYP,@VAR="",@VAR=$$GETSEG(.HLDATA,SEGTYP)
Q
; Input: DATA - HL7 data from APSP REFILL REQUEST file
; TYPE - Message segment requested
GETSEG(DATA,TYPE) ;
N X,RET,DAT,Q
S RET="",(X,Q)=0 F S X=$O(DATA(X)) Q:'X!(Q) D
.S DAT=$G(DATA(X)) I DAT="" S RET="" Q
.I $P(DAT,"|")=TYPE S RET=DAT,Q=1 Q
Q RET
;
PATNAME(PIDSEG) ;
N PAT,PATLN,PATFN,PATNAME,GENDER
S PAT=$$GET1^DIQ(9009033.91,IEN,1.2,"I")
S GENDER=$$GET1^DIQ(2,PAT,.02)
I PAT,$$GET1^DIQ(9009033.91,IEN,1.2)="" S PAT=0,GENDER=""
Q:PAT>0 PAT_";"_$$GET1^DIQ(9009033.91,IEN,1.2)_";"_$$FMTE^XLFDT($$DOB^AUPNPAT(PAT),"5Z")_";"_GENDER
S PAT=$P(PIDSEG,"|",6) I '$L(PAT) Q ";"
S PAT=$TR(PAT,";",":")
S PATLN=$P(PAT,U),PATFN=$P(PAT,U,2)
S PATNAME=PATLN_","_PATFN
Q ";"_PATNAME_";"_$$GETPDOB(IEN)_";"_$$GETPGEN(IEN)
; Return Drug Name or mapped Orderable Item
DRGNAME(APSPRXO) ;EP-
N RET
S RET=$$GET1^DIQ(9009033.91,IEN,1.1,"I")
Q:RET>0 RET_";"_$P($P(APSPRXO,"|",2),U,2) ;$$GET1^DIQ(9009033.91,IEN,1.1)
S RET=$P($P(APSPRXO,"|",2),U,2) I '$L(RET) Q ";"
Q ";"_$TR(RET,";",":")
ORD(IEN) ;Order details D:30 QTY:30 RF:2 DAW:No Indication: 401.9
N SUP,QTY,REF,DAW,IND
S SUP=+$$GET1^DIQ(9009033.91,IEN,1.5)
S QTY=+$$GET1^DIQ(9009033.91,IEN,1.4)
S REF=+$$GET1^DIQ(9009033.91,IEN,1.9)
S DAW=$$GET1^DIQ(9009033.91,IEN,1.12)
S IND=$$GET1^DIQ(9009033.91,IEN,7.2)
Q "D:"_SUP_" QTY:"_QTY_" RF:"_REF_" DAW:"_DAW_" Indication: "_IND
DUPS(IEN) ;Return if there are duplicate entries
N CNT,RRNUM,NIEN
S CNT=0
S NIEN=0 F S NIEN=$O(^APSPRREQ(IEN,9,NIEN)) Q:'NIEN D
.S CNT=CNT+1
Q CNT
GHLDAT(IEN) ; Get HL7 message data from APSP REFILL REQUEST FILE
N HLMSG
S HLMSG=$$GET1^DIQ(9009033.91,IEN,5,"","HLDATA")
Q HLMSG
TMPGBL() ;EP
K ^TMP("APSPESG",$J) Q $NA(^($J))
; Return boolean flag if entry matches status filter
CANSHOW(IEN,FILTER) ;EP -
N STA
S STA=+$P(^APSPRREQ(IEN,0),U,3)
Q $S(FILTER[STA:1,1:0) ;$S(STA<2!(STA=4):1,1:0)
; Return boolean flag if entry matches date range criteria
MATCHDT(IEN,TYPE,START,STOP) ;EP-
Q:'TYPE 1 ; date check not requested
N RES,N0,LD,MD,ACT
S STOP=STOP+.99
S N0=^APSPRREQ(IEN,0),MD=$P(N0,U,4),LD=$P(N0,U,7),ACT=$P(N0,U,8)
S RES=1
I TYPE=1 D ; Message Date
.I (MD<START)!(MD>STOP) S RES=0
E I TYPE=2 D ; Last Updated (.07) and Activity Action is either a 3 or 4
.I (LD<START)!(LD>STOP)!("34"'[ACT) S RES=0
Q RES
; Return Match Details
GMATCHI(IEN) ;EP-
N MATCH,TXT,CNT,STRING,X
S STRING="",CNT=0,TXT=""
S X=$$DUPS(IEN) ;Check for duplicate entries
I X>0 D
.S TXT="Duplicate Request ("_X_")" D ADD(TXT,.STRING)
S MATCH=$$GET1^DIQ(9009033.91,IEN,.11)
I MATCH["Z" S TXT="This order cannot be renewed" D ADD(TXT,.STRING)
I MATCH'["O" S TXT="Failed to map Order Number" D ADD(TXT,.STRING)
I MATCH'["D" S TXT="Failed to map Provider" D ADD(TXT,.STRING)
I MATCH'["M" S TXT="Failed to map Med" D ADD(TXT,.STRING)
I MATCH'["P" S TXT="Failed to map Patient" D ADD(TXT,.STRING)
I FILTER'=1 D
.I MATCH["Z"!(MATCH'["D") S TXT="[DENY ONLY]" D ADD(TXT,.STRING)
.E S TXT="[MAP OR DENY]" D ADD(TXT,.STRING)
Q STRING
ADD(TXT,STRING) ;EP-
S CNT=CNT+1
I CNT>1 S STRING=STRING_";"_TXT
E S STRING=TXT
Q
; Return details of the SureScript Request
; Input: IEN - IEN to APSP REFILL REQUEST file
DETAIL(DATA,IEN) ; EP-
N HLMSG,DLM,APSPMSH,APSPPID,APSPORC,APSPRXO,APSPRXE,APSPRXR
N PAT,QTY,PROVDAT,PROV,DRUG,INST,STR,UNITS,ROUTE,NOUN,CONJ
N USCHDUR,MEDUNITS,REFILLS,PHARM,SIGDAT,HLECH,DONE,DUR
N SCHITEM,SCHUPD,SCHARY,INTERVAL,TOTDUR
S HLECH=$P($G(APSPMSH),"|",2) I '$L(HLECH) S HLECH="^~\&"
F I=1:1:4 D
.S HLECH(I)=$E(HLECH,I)
S HLMSG=$$GHLDAT^APSPESLP(IEN)
D SHLVARS^APSPESLP
S DLM="|"
S PAT=$$PATNAME^APSPESLP(APSPPID) I '$L(PAT) S PAT="**UNKNOWN**"
S QTY=+$P(APSPRXO,DLM,12),PROVDAT=$P(APSPORC,DLM,13),PROV=$P(PROVDAT,HLECH(1),2)_","_$P(PROVDAT,HLECH(1),3)
S DRUG=$P($P($G(APSPRXO),DLM,2),U,2),INST=$P($P($G(APSPRXO),DLM,7),U,2)
S STR=$P($G(APSPRXO),DLM,3),UNITS=$P($P($G(APSPRXO),DLM,5),HLECH(1),2),ROUTE=$P($G(APSPRXR),DLM,2)
S NOUN=$P($G(APSPRXO),DLM,6) I $L(NOUN) S NOUN=$O(^APSPNCP(9009033.7,"B",NOUN,0)),NOUN=$$GET1^DIQ(9009033.7,NOUN,1,"E")
S USCHDUR=$P($G(APSPORC),DLM,8),MEDUNITS=$P($P($G(APSPRXO),DLM,20),HLECH(1),2)
S REFILLS=0
S PHARM=$$GET1^DIQ(9009033.91,IEN,1.7,"E")
S SIGDAT=$P($P(APSPRXO,"|",8),"^",2)
S DONE=0
F I=1:1 D Q:DONE
.S SCHITEM=$P(USCHDUR,HLECH(2),I)
.I '$L(SCHITEM) S DONE=1 Q
.S SCHUPD=$P(SCHITEM,HLECH(1)) I 'SCHUPD S SCHUPD=1
.S INTERVAL=$P(SCHITEM,HLECH(1),2),DUR=$P(SCHITEM,HLECH(1),3),CONJ=$P(SCHITEM,HLECH(1),9)
.S SCHARY(I)=SCHUPD_U_INTERVAL_U_DUR_U_CONJ
.S TOTDUR=$G(TOTDUR)+DUR
S DATA=$$TMPGBL^CIAVMRPC
D CAPTURE^CIAUHFS("D DISPHL7^APSPESLP(PAT,QTY,PROV,DRUG,INST,STR,UNITS,ROUTE,NOUN,.SCHARY,MEDUNITS,REFILLS,PHARM,SIGDAT)",DATA)
Q
; Supports the mapping process
; Update entry
; Input: IEN - IEN to APSP Refil Request File
; FLD - Field number
; VAL - Value to set
; NOSTS - Do not update status
STORE(DATA,IEN,FLD,VAL,NOSTS) ;EP-
N FDA,ERR,FILTER
S FILTER=$G(FILTER,0)
S NOSTS=+$G(NOSTS)
S FDA(9009033.91,IEN_",",FLD)=VAL
S:FLD=".08" FDA(9009033.91,IEN_",",.09)=$G(DUZ)
I 'NOSTS D
.S:$P($G(^APSPRREQ(IEN,0)),U,3)'=4 FDA(9009033.91,IEN_",",.03)=4
D FILE^DIE("K","FDA","ERR")
I '$D(ERR) S DATA=$$GETITM(IEN)
E S DATA="0^Unable to update log"
Q
; Return value for file/field
GETVAL(DATA,FIL,IEN,FLD,FLG) ;EP-
S DATA=$$GET1^DIQ(FIL,IEN,FLD,.FLG)
Q
; Update entry with medication dosing information
STOREDOS(DATA,IEN,FLDARY) ;EP-
N FDA,ERR
I 'IEN!'$D(FLDARY) S DATA="1^INSUFFICIENT DATA TO STORE"
D FILE^DIE("K","FDA","ERR")
I '$D(ERR) S DATA=1
E S DATA="0^"_$G(ERR)
Q
; Returns subset of active providers having a SPI number.
NPSPI(DATA,FROM,DIR,MAX) ;EP-
N IEN,CNT
S FROM=$G(FROM),DIR=$G(DIR,1),MAX=$G(MAX,44),CNT=0
F S FROM=$O(^VA(200,"B",FROM),DIR),IEN="" Q:FROM="" D:$E(FROM)'="*" Q:CNT'<MAX
.F S IEN=$O(^VA(200,"B",FROM,IEN),DIR) Q:'IEN D
..I $D(^XUSEC("PROVIDER",IEN)),$$ACTIVE^XUSER(IEN),$$AUTH(IEN),$$SPI^APSPES1(IEN) S CNT=CNT+1,DATA(CNT)=IEN_U_FROM
Q
; Return authorization of user to write meds
AUTH(PRV) ;EP-
N RES
D AUTH^ORWDPS32(.RES,PRV)
Q 'RES
; Return mapping details for a given entry
GETREC(DATA,IEN) ;EP-
N REC,TXT,CNT
S DATA=$$TMPGBL,CNT=1
I '$D(^APSPRREQ(IEN,0)) S DATA(0)="1^RECORD NOT FOUND"
S REC=$G(^APSPRREQ(IEN,1))
S @DATA@(0)=0
S @DATA@(CNT)=$P(REC,U)_";"_$$GET1^DIQ(101.43,+$P(REC,U),.01)_U_$P(REC,U,4)_U_$P(REC,U,5)_U_$$GETDRUG(IEN)
S CNT=CNT+1
D ADDMISIG(2)
D ADDMISIG(3)
Q
; Adds Medication Instructions and SIG to output array
ADDMISIG(NODE) ;EP-
N LP
S LP=0 F S LP=$O(^APSPRREQ(IEN,NODE,LP)) Q:'LP D
.S TXT=$G(^APSPRREQ(IEN,NODE,LP,0))
.Q:'$L(TXT)
.S CNT=CNT+1
.S @DATA@(CNT)=$S(NODE=2:"d~",NODE=3:"s~",1:"")_TXT
Q
;
GETDRUG(IEN) ;EP-
N DLM,HLECH,I,HLMSG
D HL7INIT(IEN)
Q $P($P($G(APSPRXO),DLM,2),U,2)
; Return patient DOB from HL7 content
GETPDOB(IEN) ;EP-
N DLM,HLECH,I,HLMSG
D HL7INIT(IEN)
S HLMSG=$$GHLDAT^APSPESLP(IEN) D SHLVARS^APSPESLP
Q $$FMTE^XLFDT($$FMDATE^HLFNC($P(APSPPID,DLM,8)),"5Z")
; Return patient Gender from HL7 context
GETPGEN(IEN) ;EP-
N DLM,HLECH,I,HLMSG,G
D HL7INIT(IEN)
S G=$P(APSPPID,DLM,9)
Q $S(G="M":"MALE",G="F":"FEMALE",G="O":"OTHER",1:"UNKNOWN")
; Return Patient Phone Number from HL7 context
GETPPHN(IEN) ;EP-
N DLM,HLECH,I,HLMSG
D HL7INIT(IEN)
Q $$FMTPHN^APSPES2($P($P(APSPPID,DLM,14),HLECH(1),1))
; Return SIG from HL7 content
GETSIG(IEN) ;EP-
N DLM,HLECH,I,HLMSG
D HL7INIT(IEN)
Q $P($P(APSPRXO,DLM,8),HLECH(1),2)
; Return count and patient flag - used by REFREQ CIA EVENT
QUECHECK(DFN) ;EP-
N IEN,CNT,PFLG,FILTER
S DFN=$G(DFN,$$GETVAR^CIANBUTL("PATIENT.ID.MRN",,"CONTEXT.PATIENT"))
S FILTER="014"
S (IEN,CNT)=0 F S IEN=$O(^APSPRREQ(IEN)) Q:'IEN D
.Q:'$$CANSHOW(IEN,FILTER)
.S CNT=CNT+1
Q +$G(CNT)_U_$S(DFN>0:$O(^APSPRREQ("E",DFN,0))>0,1:0)
;
QUEVWCNT(DATA,DFN) ;EP-
S DATA=$$QUECHECK(DFN)
Q
; Return data for a given IEN to refresh the ListView
GETIDATA(DATA,IEN,FILTER) ;EP-
S FILTER=$G(FILTER,0)
I $G(IEN) S DATA=$$GETITM(IEN)
E S DATA="0^Unable to obtain information"
Q
; Init HL7 variables
HL7INIT(IEN) ;EP--
S DLM="|"
S HLECH="^~\&"
F I=1:1:4 D
.S HLECH(I)=$E(HLECH,I)
S HLMSG=$$GHLDAT^APSPESLP(IEN) D SHLVARS^APSPESLP
Q
;Change provider on a refill request that has been processed
CHGPRV(DATA,IEN,PRVIEN) ;EP
N ORID,ORNP,ORL,ORVP,REASON,REC,DATA,PRMT,FDA
S REASON="" S REASON=$O(^ORD(100.03,"B","Obsolete Order",REASON))
S ORID=$$GET1^DIQ(9009033.91,IEN,.02,"I")
S ORNP=$$GET1^DIQ(9009033.91,IEN,1.3,"I")
S ORL=$$GET1^DIQ(9009033.91,IEN,1.6,"I")
S ORVP=$$GET1^DIQ(9009033.91,IEN,1.2,"I")
S ORDUZ=DUZ
S PRMT="OR GTX SSRREQIEN"
D RESP^ORCSAVE2(ORID,PRMT,"ZZ")
;Delete the old order
D DC^ORWDXA(.REC,ORID,ORNP,ORL,REASON,0,1)
;Kill the alert
N XQAKILL,ORNIFN
S ORNIFN=$O(^ORD(100.9,"B","SS REFILL REQUEST SIGNATURE",0))
S XQAKILL=$$XQAKILL^ORB3F1(ORNIFN) ; unsigned orders notif
S XQAID=$P($G(^ORD(100.9,ORNIFN,0)),U,2)_","_+ORVP_","_ORNIFN D DELETEA^XQALERT K XQAID
S ORNIFN=$O(^ORD(100.9,"B","ORDER REQUIRES ELEC SIGNATURE",0))
S XQAKILL=$$XQAKILL^ORB3F1(ORNIFN) ; unsigned orders notif
S XQAID=$P($G(^ORD(100.9,ORNIFN,0)),U,2)_","_+ORVP_","_ORNIFN D DELETEA^XQALERT K XQAID
;Update the APSP Refill request file
S FDA(9009033.91,IEN_",",.02)="@"
S FDA(9009033.91,IEN_",",.07)=$$NOW^XLFDT()
S FDA(9009033.91,IEN_",",1.3)=PRVIEN
S FDA(9009033.91,IEN_",",1.11)=1
D FILE^DIE("","FDA","ERR")
;Redo the order
D PROCESS^APSPESG2(.DATA,IEN)
Q
APSPESG ;IHS/MSC/MGH - Process entries from APSP REFILL REQUEST file ;24-Jul-2013 08:40;PLS
+1 ;;7.0;IHS PHARMACY MODIFICATIONS;**1016**;Sep 23,2004;Build 74
+2 ;==================================================================
+3 ;RPC calls for refill request component
+4 ;Input: FILTER - string containing status values
+5 ; TCHK - Flag indicating type of date check
+6 ; 0 - no date check (default)
+7 ; 1 - Message Date
+8 ; 2 - Last Updated Date ( used for denied entries)
+9 ; START - Start date (earliest date)
+10 ; STOP - Stop date (most recent date)
GETLIST(RET,FILTER,TCHK,START,STOP) ; -- Return list of unprocessed refills
+1 NEW IEN,CNT
+2 SET RET=$$TMPGBL()
+3 SET FILTER=$GET(FILTER,"0146")
+4 SET (IEN,CNT)=0
FOR
SET IEN=$ORDER(^APSPRREQ(IEN))
IF 'IEN
QUIT
Begin DoDot:1
+5 ; do not display if the status is 'processed', there is an OERR order number, or the HL7 data is misisng
+6 ;I $P(^APSPRREQ(IEN,0),U,2)!('$O(^APSPRREQ(IEN,5,0))) Q
+7 IF '$$CANSHOW(IEN,FILTER)
QUIT
+8 IF '$$MATCHDT(IEN,TCHK,START,STOP)
QUIT
+9 SET CNT=CNT+1
+10 SET @RET@(CNT)=$$GETITM(IEN)
End DoDot:1
+11 QUIT
+12 ; Return string containing data for a single item
GETITM(IEN) ;EP-
+1 ;Array will include IEN [1] ^ MESSAGE ID;STATUS [2] ^ IEN;PATIENT NAME (DOB)[3] ^ DRUG NAME[4] ^ DATE [5] ^ PHARMACY [6] ^ PHARMACY ZIP [7] ^
+2 ; PROVIDER ID (IEN;NAME) [8] ^ LOCATION ID (IEN;NAME) [9] ^
+3 ;IEN_U_MSGID_";"_IND_U_PATNAME_U_DRUG_U_ITMDATE_U_PHARMNM_U_PHARMZIP_U_PRVID_U_LOCID
+4 NEW LINE,MSGID,SEG,HLDATA,APSPMSH,APSPPID,APSPORC,APSPRX0,APSPRXE,DRUG,PAT,PATLN,PATFN,LINEVAR,ITMDATE
+5 NEW PATNAME,STAT,PIEN,PNAM,PPHN,PADDR,IND,PTID,PRVID,PTPHN,DNYDT,DNYDTF,DNYUSR,DNYRSN,MATCH
+6 SET STAT=+$$GET1^DIQ(9009033.91,IEN,.03,"I")
+7 SET MSGID=$$GET1^DIQ(9009033.91,IEN,.01,"E")
SET HLMSG=$$GHLDAT(IEN)
+8 DO SHLVARS
+9 ; From HL7 Message content
SET PATNAME=$$PATNAME(APSPPID)
+10 SET PTPHN=$$GETPPHN(IEN)
+11 SET DRUG=$$DRGNAME(APSPRXO)
+12 SET ITMDATE=$$GET1^DIQ(9009033.91,IEN,.04,"I")
+13 SET ITMDTFMT=$$FMTE^XLFDT(ITMDATE,"5Z")
+14 SET ITMDTFMT=$TRANSLATE(ITMDTFMT,"@"," ")
+15 SET (DNYDT,DNYDTF,DNYUSR,DNYRSN)=""
+16 IF STAT=3!(STAT=5)
Begin DoDot:1
+17 SET DNYDT=$$GET1^DIQ(9009033.91,IEN,.07,"I")
+18 SET DNYDTF=$$FMTE^XLFDT(DNYDT,"5Z")
+19 SET DNYDTF=$TRANSLATE(DNYDTF,"@"," ")
+20 SET DNYUSR=$$GET1^DIQ(9009033.91,IEN,.09)
+21 SET DNYRSN=$$GET1^DIQ(9009033.91,IEN,4)
End DoDot:1
+22 SET PIEN=$$GET1^DIQ(9009033.91,IEN,1.7,"I")
+23 SET PNAM=$$GET1^DIQ(9009033.9,PIEN,.01)
+24 ;Pharmacy Phone
SET PPHN=$$FMTPHN^APSPES2($$GET1^DIQ(9009033.9,PIEN,2.1))
+25 ;Pharmacy Fax
SET PFAX=$$FMTPHN^APSPES2($$GET1^DIQ(9009033.9,PIEN,2.2))
+26 SET PADD=$$PADDR^APSPESG1(PIEN)
+27 SET IND=$SELECT(STAT=6:5,STAT=4:4,STAT=1:13,1:3)
+28 SET PTID=$$GET1^DIQ(9009033.91,IEN,1.2,"I")_";"_$$GET1^DIQ(9009033.91,IEN,1.2)
+29 SET PRVID=$$GET1^DIQ(9009033.91,IEN,1.3,"I")_";"_$$GET1^DIQ(9009033.91,IEN,1.3)
+30 SET LOCID=$$GET1^DIQ(9009033.91,IEN,1.6,"I")_";"_$$GET1^DIQ(9009033.91,IEN,1.6)
+31 SET MATCH=$$GET1^DIQ(9009033.91,IEN,.11)
+32 ;Order details D:30 QTY:30 RF:2 DAW:No Indication: 401.9
SET ORDINFO=$$ORD(IEN)
+33 ;Notes to Pharmacist
SET NTPHM=$$GET1^DIQ(9009033.91,IEN,4.1)
+34 QUIT IEN_U_MSGID_";"_IND_U_PATNAME_U_DRUG_U_ITMDATE_";"_ITMDTFMT_U_PIEN_";"_PNAM_U_PPHN_";"_PFAX_U_PTID_U_PRVID_U_LOCID_U_$$GETSIG(IEN)_U_PTPHN_U_PADD_U_DNYDT_";"_DNYDTF_U_DNYUSR_U_DNYRSN_U_MATCH_U_ORDINFO_U_NTPHM_U_$$GMATCHI(IEN)
+35 ;TODO - REFILL REQUEST DENIED;ACTIVITY ACTION USER;DENY REASON
+36 ;
SHLVARS ; Set up HL segment data
+1 NEW SEGTYP,VAR
+2 FOR SEGTYP="MSH","PID","ORC","RXO","RXE","RXR","RXD","DG1"
SET VAR="APSP"_SEGTYP
SET @VAR=""
SET @VAR=$$GETSEG(.HLDATA,SEGTYP)
+3 QUIT
+4 ; Input: DATA - HL7 data from APSP REFILL REQUEST file
+5 ; TYPE - Message segment requested
GETSEG(DATA,TYPE) ;
+1 NEW X,RET,DAT,Q
+2 SET RET=""
SET (X,Q)=0
FOR
SET X=$ORDER(DATA(X))
IF 'X!(Q)
QUIT
Begin DoDot:1
+3 SET DAT=$GET(DATA(X))
IF DAT=""
SET RET=""
QUIT
+4 IF $PIECE(DAT,"|")=TYPE
SET RET=DAT
SET Q=1
QUIT
End DoDot:1
+5 QUIT RET
+6 ;
PATNAME(PIDSEG) ;
+1 NEW PAT,PATLN,PATFN,PATNAME,GENDER
+2 SET PAT=$$GET1^DIQ(9009033.91,IEN,1.2,"I")
+3 SET GENDER=$$GET1^DIQ(2,PAT,.02)
+4 IF PAT
IF $$GET1^DIQ(9009033.91,IEN,1.2)=""
SET PAT=0
SET GENDER=""
+5 IF PAT>0
QUIT PAT_";"_$$GET1^DIQ(9009033.91,IEN,1.2)_";"_$$FMTE^XLFDT($$DOB^AUPNPAT(PAT),"5Z")_";"_GENDER
+6 SET PAT=$PIECE(PIDSEG,"|",6)
IF '$LENGTH(PAT)
QUIT ";"
+7 SET PAT=$TRANSLATE(PAT,";",":")
+8 SET PATLN=$PIECE(PAT,U)
SET PATFN=$PIECE(PAT,U,2)
+9 SET PATNAME=PATLN_","_PATFN
+10 QUIT ";"_PATNAME_";"_$$GETPDOB(IEN)_";"_$$GETPGEN(IEN)
+11 ; Return Drug Name or mapped Orderable Item
DRGNAME(APSPRXO) ;EP-
+1 NEW RET
+2 SET RET=$$GET1^DIQ(9009033.91,IEN,1.1,"I")
+3 ;$$GET1^DIQ(9009033.91,IEN,1.1)
IF RET>0
QUIT RET_";"_$PIECE($PIECE(APSPRXO,"|",2),U,2)
+4 SET RET=$PIECE($PIECE(APSPRXO,"|",2),U,2)
IF '$LENGTH(RET)
QUIT ";"
+5 QUIT ";"_$TRANSLATE(RET,";",":")
ORD(IEN) ;Order details D:30 QTY:30 RF:2 DAW:No Indication: 401.9
+1 NEW SUP,QTY,REF,DAW,IND
+2 SET SUP=+$$GET1^DIQ(9009033.91,IEN,1.5)
+3 SET QTY=+$$GET1^DIQ(9009033.91,IEN,1.4)
+4 SET REF=+$$GET1^DIQ(9009033.91,IEN,1.9)
+5 SET DAW=$$GET1^DIQ(9009033.91,IEN,1.12)
+6 SET IND=$$GET1^DIQ(9009033.91,IEN,7.2)
+7 QUIT "D:"_SUP_" QTY:"_QTY_" RF:"_REF_" DAW:"_DAW_" Indication: "_IND
DUPS(IEN) ;Return if there are duplicate entries
+1 NEW CNT,RRNUM,NIEN
+2 SET CNT=0
+3 SET NIEN=0
FOR
SET NIEN=$ORDER(^APSPRREQ(IEN,9,NIEN))
IF 'NIEN
QUIT
Begin DoDot:1
+4 SET CNT=CNT+1
End DoDot:1
+5 QUIT CNT
GHLDAT(IEN) ; Get HL7 message data from APSP REFILL REQUEST FILE
+1 NEW HLMSG
+2 SET HLMSG=$$GET1^DIQ(9009033.91,IEN,5,"","HLDATA")
+3 QUIT HLMSG
TMPGBL() ;EP
+1 KILL ^TMP("APSPESG",$JOB)
QUIT $NAME(^($JOB))
+2 ; Return boolean flag if entry matches status filter
CANSHOW(IEN,FILTER) ;EP -
+1 NEW STA
+2 SET STA=+$PIECE(^APSPRREQ(IEN,0),U,3)
+3 ;$S(STA<2!(STA=4):1,1:0)
QUIT $SELECT(FILTER[STA:1,1:0)
+4 ; Return boolean flag if entry matches date range criteria
MATCHDT(IEN,TYPE,START,STOP) ;EP-
+1 ; date check not requested
IF 'TYPE
QUIT 1
+2 NEW RES,N0,LD,MD,ACT
+3 SET STOP=STOP+.99
+4 SET N0=^APSPRREQ(IEN,0)
SET MD=$PIECE(N0,U,4)
SET LD=$PIECE(N0,U,7)
SET ACT=$PIECE(N0,U,8)
+5 SET RES=1
+6 ; Message Date
IF TYPE=1
Begin DoDot:1
+7 IF (MD<START)!(MD>STOP)
SET RES=0
End DoDot:1
+8 ; Last Updated (.07) and Activity Action is either a 3 or 4
IF '$TEST
IF TYPE=2
Begin DoDot:1
+9 IF (LD<START)!(LD>STOP)!("34"'[ACT)
SET RES=0
End DoDot:1
+10 QUIT RES
+11 ; Return Match Details
GMATCHI(IEN) ;EP-
+1 NEW MATCH,TXT,CNT,STRING,X
+2 SET STRING=""
SET CNT=0
SET TXT=""
+3 ;Check for duplicate entries
SET X=$$DUPS(IEN)
+4 IF X>0
Begin DoDot:1
+5 SET TXT="Duplicate Request ("_X_")"
DO ADD(TXT,.STRING)
End DoDot:1
+6 SET MATCH=$$GET1^DIQ(9009033.91,IEN,.11)
+7 IF MATCH["Z"
SET TXT="This order cannot be renewed"
DO ADD(TXT,.STRING)
+8 IF MATCH'["O"
SET TXT="Failed to map Order Number"
DO ADD(TXT,.STRING)
+9 IF MATCH'["D"
SET TXT="Failed to map Provider"
DO ADD(TXT,.STRING)
+10 IF MATCH'["M"
SET TXT="Failed to map Med"
DO ADD(TXT,.STRING)
+11 IF MATCH'["P"
SET TXT="Failed to map Patient"
DO ADD(TXT,.STRING)
+12 IF FILTER'=1
Begin DoDot:1
+13 IF MATCH["Z"!(MATCH'["D")
SET TXT="[DENY ONLY]"
DO ADD(TXT,.STRING)
+14 IF '$TEST
SET TXT="[MAP OR DENY]"
DO ADD(TXT,.STRING)
End DoDot:1
+15 QUIT STRING
ADD(TXT,STRING) ;EP-
+1 SET CNT=CNT+1
+2 IF CNT>1
SET STRING=STRING_";"_TXT
+3 IF '$TEST
SET STRING=TXT
+4 QUIT
+5 ; Return details of the SureScript Request
+6 ; Input: IEN - IEN to APSP REFILL REQUEST file
DETAIL(DATA,IEN) ; EP-
+1 NEW HLMSG,DLM,APSPMSH,APSPPID,APSPORC,APSPRXO,APSPRXE,APSPRXR
+2 NEW PAT,QTY,PROVDAT,PROV,DRUG,INST,STR,UNITS,ROUTE,NOUN,CONJ
+3 NEW USCHDUR,MEDUNITS,REFILLS,PHARM,SIGDAT,HLECH,DONE,DUR
+4 NEW SCHITEM,SCHUPD,SCHARY,INTERVAL,TOTDUR
+5 SET HLECH=$PIECE($GET(APSPMSH),"|",2)
IF '$LENGTH(HLECH)
SET HLECH="^~\&"
+6 FOR I=1:1:4
Begin DoDot:1
+7 SET HLECH(I)=$EXTRACT(HLECH,I)
End DoDot:1
+8 SET HLMSG=$$GHLDAT^APSPESLP(IEN)
+9 DO SHLVARS^APSPESLP
+10 SET DLM="|"
+11 SET PAT=$$PATNAME^APSPESLP(APSPPID)
IF '$LENGTH(PAT)
SET PAT="**UNKNOWN**"
+12 SET QTY=+$PIECE(APSPRXO,DLM,12)
SET PROVDAT=$PIECE(APSPORC,DLM,13)
SET PROV=$PIECE(PROVDAT,HLECH(1),2)_","_$PIECE(PROVDAT,HLECH(1),3)
+13 SET DRUG=$PIECE($PIECE($GET(APSPRXO),DLM,2),U,2)
SET INST=$PIECE($PIECE($GET(APSPRXO),DLM,7),U,2)
+14 SET STR=$PIECE($GET(APSPRXO),DLM,3)
SET UNITS=$PIECE($PIECE($GET(APSPRXO),DLM,5),HLECH(1),2)
SET ROUTE=$PIECE($GET(APSPRXR),DLM,2)
+15 SET NOUN=$PIECE($GET(APSPRXO),DLM,6)
IF $LENGTH(NOUN)
SET NOUN=$ORDER(^APSPNCP(9009033.7,"B",NOUN,0))
SET NOUN=$$GET1^DIQ(9009033.7,NOUN,1,"E")
+16 SET USCHDUR=$PIECE($GET(APSPORC),DLM,8)
SET MEDUNITS=$PIECE($PIECE($GET(APSPRXO),DLM,20),HLECH(1),2)
+17 SET REFILLS=0
+18 SET PHARM=$$GET1^DIQ(9009033.91,IEN,1.7,"E")
+19 SET SIGDAT=$PIECE($PIECE(APSPRXO,"|",8),"^",2)
+20 SET DONE=0
+21 FOR I=1:1
Begin DoDot:1
+22 SET SCHITEM=$PIECE(USCHDUR,HLECH(2),I)
+23 IF '$LENGTH(SCHITEM)
SET DONE=1
QUIT
+24 SET SCHUPD=$PIECE(SCHITEM,HLECH(1))
IF 'SCHUPD
SET SCHUPD=1
+25 SET INTERVAL=$PIECE(SCHITEM,HLECH(1),2)
SET DUR=$PIECE(SCHITEM,HLECH(1),3)
SET CONJ=$PIECE(SCHITEM,HLECH(1),9)
+26 SET SCHARY(I)=SCHUPD_U_INTERVAL_U_DUR_U_CONJ
+27 SET TOTDUR=$GET(TOTDUR)+DUR
End DoDot:1
IF DONE
QUIT
+28 SET DATA=$$TMPGBL^CIAVMRPC
+29 DO CAPTURE^CIAUHFS("D DISPHL7^APSPESLP(PAT,QTY,PROV,DRUG,INST,STR,UNITS,ROUTE,NOUN,.SCHARY,MEDUNITS,REFILLS,PHARM,SIGDAT)",DATA)
+30 QUIT
+31 ; Supports the mapping process
+32 ; Update entry
+33 ; Input: IEN - IEN to APSP Refil Request File
+34 ; FLD - Field number
+35 ; VAL - Value to set
+36 ; NOSTS - Do not update status
STORE(DATA,IEN,FLD,VAL,NOSTS) ;EP-
+1 NEW FDA,ERR,FILTER
+2 SET FILTER=$GET(FILTER,0)
+3 SET NOSTS=+$GET(NOSTS)
+4 SET FDA(9009033.91,IEN_",",FLD)=VAL
+5 IF FLD=".08"
SET FDA(9009033.91,IEN_",",.09)=$GET(DUZ)
+6 IF 'NOSTS
Begin DoDot:1
+7 IF $PIECE($GET(^APSPRREQ(IEN,0)),U,3)'=4
SET FDA(9009033.91,IEN_",",.03)=4
End DoDot:1
+8 DO FILE^DIE("K","FDA","ERR")
+9 IF '$DATA(ERR)
SET DATA=$$GETITM(IEN)
+10 IF '$TEST
SET DATA="0^Unable to update log"
+11 QUIT
+12 ; Return value for file/field
GETVAL(DATA,FIL,IEN,FLD,FLG) ;EP-
+1 SET DATA=$$GET1^DIQ(FIL,IEN,FLD,.FLG)
+2 QUIT
+3 ; Update entry with medication dosing information
STOREDOS(DATA,IEN,FLDARY) ;EP-
+1 NEW FDA,ERR
+2 IF 'IEN!'$DATA(FLDARY)
SET DATA="1^INSUFFICIENT DATA TO STORE"
+3 DO FILE^DIE("K","FDA","ERR")
+4 IF '$DATA(ERR)
SET DATA=1
+5 IF '$TEST
SET DATA="0^"_$GET(ERR)
+6 QUIT
+7 ; Returns subset of active providers having a SPI number.
NPSPI(DATA,FROM,DIR,MAX) ;EP-
+1 NEW IEN,CNT
+2 SET FROM=$GET(FROM)
SET DIR=$GET(DIR,1)
SET MAX=$GET(MAX,44)
SET CNT=0
+3 FOR
SET FROM=$ORDER(^VA(200,"B",FROM),DIR)
SET IEN=""
IF FROM=""
QUIT
IF $EXTRACT(FROM)'="*"
Begin DoDot:1
+4 FOR
SET IEN=$ORDER(^VA(200,"B",FROM,IEN),DIR)
IF 'IEN
QUIT
Begin DoDot:2
+5 IF $DATA(^XUSEC("PROVIDER",IEN))
IF $$ACTIVE^XUSER(IEN)
IF $$AUTH(IEN)
IF $$SPI^APSPES1(IEN)
SET CNT=CNT+1
SET DATA(CNT)=IEN_U_FROM
End DoDot:2
End DoDot:1
IF CNT'<MAX
QUIT
+6 QUIT
+7 ; Return authorization of user to write meds
AUTH(PRV) ;EP-
+1 NEW RES
+2 DO AUTH^ORWDPS32(.RES,PRV)
+3 QUIT 'RES
+4 ; Return mapping details for a given entry
GETREC(DATA,IEN) ;EP-
+1 NEW REC,TXT,CNT
+2 SET DATA=$$TMPGBL
SET CNT=1
+3 IF '$DATA(^APSPRREQ(IEN,0))
SET DATA(0)="1^RECORD NOT FOUND"
+4 SET REC=$GET(^APSPRREQ(IEN,1))
+5 SET @DATA@(0)=0
+6 SET @DATA@(CNT)=$PIECE(REC,U)_";"_$$GET1^DIQ(101.43,+$PIECE(REC,U),.01)_U_$PIECE(REC,U,4)_U_$PIECE(REC,U,5)_U_$$GETDRUG(IEN)
+7 SET CNT=CNT+1
+8 DO ADDMISIG(2)
+9 DO ADDMISIG(3)
+10 QUIT
+11 ; Adds Medication Instructions and SIG to output array
ADDMISIG(NODE) ;EP-
+1 NEW LP
+2 SET LP=0
FOR
SET LP=$ORDER(^APSPRREQ(IEN,NODE,LP))
IF 'LP
QUIT
Begin DoDot:1
+3 SET TXT=$GET(^APSPRREQ(IEN,NODE,LP,0))
+4 IF '$LENGTH(TXT)
QUIT
+5 SET CNT=CNT+1
+6 SET @DATA@(CNT)=$SELECT(NODE=2:"d~",NODE=3:"s~",1:"")_TXT
End DoDot:1
+7 QUIT
+8 ;
GETDRUG(IEN) ;EP-
+1 NEW DLM,HLECH,I,HLMSG
+2 DO HL7INIT(IEN)
+3 QUIT $PIECE($PIECE($GET(APSPRXO),DLM,2),U,2)
+4 ; Return patient DOB from HL7 content
GETPDOB(IEN) ;EP-
+1 NEW DLM,HLECH,I,HLMSG
+2 DO HL7INIT(IEN)
+3 SET HLMSG=$$GHLDAT^APSPESLP(IEN)
DO SHLVARS^APSPESLP
+4 QUIT $$FMTE^XLFDT($$FMDATE^HLFNC($PIECE(APSPPID,DLM,8)),"5Z")
+5 ; Return patient Gender from HL7 context
GETPGEN(IEN) ;EP-
+1 NEW DLM,HLECH,I,HLMSG,G
+2 DO HL7INIT(IEN)
+3 SET G=$PIECE(APSPPID,DLM,9)
+4 QUIT $SELECT(G="M":"MALE",G="F":"FEMALE",G="O":"OTHER",1:"UNKNOWN")
+5 ; Return Patient Phone Number from HL7 context
GETPPHN(IEN) ;EP-
+1 NEW DLM,HLECH,I,HLMSG
+2 DO HL7INIT(IEN)
+3 QUIT $$FMTPHN^APSPES2($PIECE($PIECE(APSPPID,DLM,14),HLECH(1),1))
+4 ; Return SIG from HL7 content
GETSIG(IEN) ;EP-
+1 NEW DLM,HLECH,I,HLMSG
+2 DO HL7INIT(IEN)
+3 QUIT $PIECE($PIECE(APSPRXO,DLM,8),HLECH(1),2)
+4 ; Return count and patient flag - used by REFREQ CIA EVENT
QUECHECK(DFN) ;EP-
+1 NEW IEN,CNT,PFLG,FILTER
+2 SET DFN=$GET(DFN,$$GETVAR^CIANBUTL("PATIENT.ID.MRN",,"CONTEXT.PATIENT"))
+3 SET FILTER="014"
+4 SET (IEN,CNT)=0
FOR
SET IEN=$ORDER(^APSPRREQ(IEN))
IF 'IEN
QUIT
Begin DoDot:1
+5 IF '$$CANSHOW(IEN,FILTER)
QUIT
+6 SET CNT=CNT+1
End DoDot:1
+7 QUIT +$GET(CNT)_U_$SELECT(DFN>0:$ORDER(^APSPRREQ("E",DFN,0))>0,1:0)
+8 ;
QUEVWCNT(DATA,DFN) ;EP-
+1 SET DATA=$$QUECHECK(DFN)
+2 QUIT
+3 ; Return data for a given IEN to refresh the ListView
GETIDATA(DATA,IEN,FILTER) ;EP-
+1 SET FILTER=$GET(FILTER,0)
+2 IF $GET(IEN)
SET DATA=$$GETITM(IEN)
+3 IF '$TEST
SET DATA="0^Unable to obtain information"
+4 QUIT
+5 ; Init HL7 variables
HL7INIT(IEN) ;EP--
+1 SET DLM="|"
+2 SET HLECH="^~\&"
+3 FOR I=1:1:4
Begin DoDot:1
+4 SET HLECH(I)=$EXTRACT(HLECH,I)
End DoDot:1
+5 SET HLMSG=$$GHLDAT^APSPESLP(IEN)
DO SHLVARS^APSPESLP
+6 QUIT
+7 ;Change provider on a refill request that has been processed
CHGPRV(DATA,IEN,PRVIEN) ;EP
+1 NEW ORID,ORNP,ORL,ORVP,REASON,REC,DATA,PRMT,FDA
+2 SET REASON=""
SET REASON=$ORDER(^ORD(100.03,"B","Obsolete Order",REASON))
+3 SET ORID=$$GET1^DIQ(9009033.91,IEN,.02,"I")
+4 SET ORNP=$$GET1^DIQ(9009033.91,IEN,1.3,"I")
+5 SET ORL=$$GET1^DIQ(9009033.91,IEN,1.6,"I")
+6 SET ORVP=$$GET1^DIQ(9009033.91,IEN,1.2,"I")
+7 SET ORDUZ=DUZ
+8 SET PRMT="OR GTX SSRREQIEN"
+9 DO RESP^ORCSAVE2(ORID,PRMT,"ZZ")
+10 ;Delete the old order
+11 DO DC^ORWDXA(.REC,ORID,ORNP,ORL,REASON,0,1)
+12 ;Kill the alert
+13 NEW XQAKILL,ORNIFN
+14 SET ORNIFN=$ORDER(^ORD(100.9,"B","SS REFILL REQUEST SIGNATURE",0))
+15 ; unsigned orders notif
SET XQAKILL=$$XQAKILL^ORB3F1(ORNIFN)
+16 SET XQAID=$PIECE($GET(^ORD(100.9,ORNIFN,0)),U,2)_","_+ORVP_","_ORNIFN
DO DELETEA^XQALERT
KILL XQAID
+17 SET ORNIFN=$ORDER(^ORD(100.9,"B","ORDER REQUIRES ELEC SIGNATURE",0))
+18 ; unsigned orders notif
SET XQAKILL=$$XQAKILL^ORB3F1(ORNIFN)
+19 SET XQAID=$PIECE($GET(^ORD(100.9,ORNIFN,0)),U,2)_","_+ORVP_","_ORNIFN
DO DELETEA^XQALERT
KILL XQAID
+20 ;Update the APSP Refill request file
+21 SET FDA(9009033.91,IEN_",",.02)="@"
+22 SET FDA(9009033.91,IEN_",",.07)=$$NOW^XLFDT()
+23 SET FDA(9009033.91,IEN_",",1.3)=PRVIEN
+24 SET FDA(9009033.91,IEN_",",1.11)=1
+25 DO FILE^DIE("","FDA","ERR")
+26 ;Redo the order
+27 DO PROCESS^APSPESG2(.DATA,IEN)
+28 QUIT
