APSPESG.m

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