BEHORXF1 ;MSC/IND/PLS - XML Support for Pharmacy Rx Gen service ;22-Aug-2013 10:07;DU
;;1.1;BEH COMPONENTS;**009007,009009,009010**;Sep 18, 2007
;=================================================================
; RPC: BEHORXF1 SFMTXML
; Save prescription xml format
;
SFMTXML(DATA,NAME,VAL,ENT) ;EP-
S VAL=NAME
S:$D(VAL)'=11 VAL(1,0)=""
D EN^XPAR(ENT,"BEHORX PRINT FORMATS",NAME,.VAL,.DATA)
Q
; Creates log entry for Order for Signature prints
; Input: ORIFN - IEN to Order File (100)
;
UPTLOG(DATA,ORIFN,ACTION,ARY) ;EP-
N FDA,ERR,FN,IENS,USR
S IENS="+1,"
S USR=$S($G(ARY("USER")):ARY("USER"),1:DUZ)
S DATA=0
S FN=90460.08
S:ACTION'=2 ARY("COM")="Order for signature printed on "_ARY("DEV")_"."
S FDA(FN,IENS,.01)=$$NOW^XLFDT()
S FDA(FN,IENS,.02)=ORIFN
S FDA(FN,IENS,.03)=USR
S FDA(FN,IENS,.04)=$S(ACTION=2:"R",1:"P")
S FDA(FN,IENS,1)=$G(ARY("DEV"))
S FDA(FN,IENS,2)=$G(ARY("COM"))
D UPDATE^DIE(,"FDA",,"ERR")
I '$D(ERR) S DATA=1
E S DATA="0^Unable to update log"
Q
; Validate Queue List
VALQUE(DATA,ORLST) ;EP-
;CHECK SIGNATURE STATUS (<>2), oRDER STATUS ; EITHER PENDING or ACTIVE
; Package = OUTPATIENT PHARMACY
; Dialog = PSO OERR
; To = OUTPATIENT MEDICATIONS
; Status = Active = prescription must have AUTOFINISHED field set to YES.
; Pending = OI must be CII
; Who = Logged in user (DUZ)
; CII = OI is CII
; Type = Outpatient
S DATA=$$TMPGBL
N ID,LP,PKG,DLG,NOA,STS,WHO,TO,PSIFN,TYPE,ATF,CNT,ADD,OI
S CNT=0
S LP=0 F S LP=$O(ORLST(LP)) Q:LP="" D
.S ADD=0,ID=ORLST(LP)
.S PKG=$$GET1^DIQ(100,+ID,12)="OUTPATIENT PHARMACY"
.S DLG=$$GET1^DIQ(100,+ID,2)="PSO OERR"
.S TO=$$GET1^DIQ(100,+ID,23)="OUTPATIENT MEDICATIONS"
.S TYPE=$P($G(^OR(100,+ID,0)),U,12)="O"
.Q:'PKG!'DLG!'TO!'TYPE
.S PSIFN=+$G(^OR(100,+ID,4))
.Q:'PSIFN
.S STS=$$GET1^DIQ(100,+ID,5)
.S OI=$$VALUE^ORCSAVE2(+ID,"ORDERABLE")
.I STS="ACTIVE" D
..Q:('$$ERXOI^APSPFNC6(OI,"2345"))&('$$GET^XPAR("ALL","BEHORX AUTO-RECEIPT"))&(+$P($G(^PSRX(PSIFN,999999921)),U,4))
..S ATF=$P($G(^PSRX(PSIFN,999999921)),U,3)
..D:ATF ADDID(ID)
.E I STS="PENDING" D
..Q:'$$ERXOI^APSPFNC6(OI,"2"_$S($$GET^XPAR("ALL","BEHORX PRINT QUEUE C35"):"345",1:""))
..D ADDID(ID)
Q
ADDID(ID) ;EP-
S CNT=CNT+1
S @DATA@(CNT)=ID
Q
; Return XML representation of Orders in array
ORDRSXML(DATA,ORDARY,DFN) ;EP-
N CNT,LP
S CNT=0
S DATA=$$TMPGBL
D XMLHDR
D ORDSXML(.ORDARY)
Q
; Return XML representation of Prescription
MEDXML(DATA,ORDERID,DFN,XTRA) ;EP-
N CNT,PSIFN,LP
S CNT=0
S DATA=$$TMPGBL
D XMLHDR
D ADD($$TAG("Prescriptions",0))
S PSIFN=$$GETPSIFN^BEHORXFN(ORDERID)
I $D(XTRA) D
.S LP="" F S LP=$O(XTRA(LP)) Q:LP="" D
..D ADD(XTRA(LP))
D RXXML(PSIFN,+ORDERID,1)
D ADD($$TAG("Prescriptions",1))
Q
; Return XML representation of Prescriptions in array
MEDSXML(DATA,ORDARY,DFN) ;EP-
N CNT,LP,ID
S CNT=0
S DATA=$$TMPGBL
D XMLHDR
D ADD($$TAG("Prescriptions",0))
S LP=0 F S LP=$O(ORDARY(LP)) Q:LP="" D
.S ID=+ORDARY(LP)
.S PSIFN=$$GETPSIFN^BEHORXFN(ID)
.Q:PSIFN'=+PSIFN
.D RXXML(PSIFN,ID,1)
D ADD($$TAG("Prescriptions",1))
Q
; Return XML representation for Order, Prescription and/or Receipt
BATCHXML(DATA,ORDARY,DFN) ;EP-
N CNT,LP,PSIFN
S CNT=0
S DATA=$$TMPGBL
D XMLHDR
D ADD($$TAG("Batch",0))
D RXSXML(.ORDARY)
D ORDSXML(.ORDARY)
I $$GET^XPAR("ALL","BEHORX AUTO-RECEIPT") D RECSXML(.ORDARY)
D ADD($$TAG("Batch",1))
Q
RXSXML(ORDARY) ;EP-Build Prescription xml
N ID
D ADD($$TAG("Prescriptions",0))
S LP=0 F S LP=$O(ORDARY(LP)) Q:LP="" D
.S ID=+ORDARY(LP)
.S PSIFN=$$GETPSIFN^BEHORXFN(ID)
.I $$ISA("RX",PSIFN) D
..D RXXML(PSIFN,ID,1)
D ADD($$TAG("Prescriptions",1))
Q
ORDSXML(ORDARY) ;EP-Build Order XML
N ID
D ADD($$TAG("Orders",0))
S LP=0 F S LP=$O(ORDARY(LP)) Q:LP="" D
.S ID=+ORDARY(LP)
.I $$ISA("OR",ID) D
..D ORDXML(ID)
D ADD($$TAG("Orders",1))
Q
RECSXML(ORDARY) ;EP-Build Receipt XML
N ID
N PNM
S PNM=$$GET1^DIQ(2,DFN,.01)
S PNM=$P(PNM,",",2)_" "_$P(PNM,",")
D ADD($$TAG("Transactions",0))
D ADD($$TAG("PatientName",2,PNM))
D BLDPT^BEHORXF2(DFN,"")
D BLDPTADD^BEHORXF2(DFN)
D DATA^BEHORXF2(DFN)
S LP=0 F S LP=$O(ORDARY(LP)) Q:LP="" D
.S ID=+ORDARY(LP)
.S PSIFN=$$GETPSIFN^BEHORXFN(+ORDARY(LP))
.I $$ISA("RC",PSIFN) D
..D RECEIPT^BEHORXRT(PSIFN,ID)
D ADD($$TAG("Transactions",1))
Q
ISA(TYPE,ID) ;EP-
N RET,PKUP,ORDID
S RET=0
I TYPE="RX" D
.;ID=RX IEN
.;ATF,PHM,ACTIVE AND NOT PSTATE="E" - PHM not required if PICKUP is a 'P'
.S ORDID=+$$GET1^DIQ(52,ID,39.3,"I")
.S PKUP=$$VALUE^ORCSAVE2(ORDID,"PICKUP")
.S RET=''$$GET1^DIQ(52,ID,9999999.23,"I")&($S(PKUP="P":1,1:''$$GET1^DIQ(52,ID,9999999.24,"I")))&('$$GET1^DIQ(52,ID,100,"I"))&($$PSTATE^BEHORXFN(ID)'="E")
E I TYPE="OR" D
.;ID=ORDER IEN
.S RET=$$GET1^DIQ(100,+ID,5)="PENDING"
E I TYPE="RC" D
.;ID=RX IEN
.S RET=$$PSTATE^BEHORXFN(ID)="E"
Q RET
; Add XML record for a prescription
RXXML(RX,ORDID,ADDHDR) ;EP-
N RXINFO,PRVIEN,QTY,QTYW,RRIEN,SSNUM,INI,PHMI,DRG,LNAME,DRUG,DISPU,RXDIV
K ^TMP("PS",$J)
D OEL^PSOORRL(DFN,RX)
S DRUG=$$GET1^DIQ(52,RX,6,"I")
S DISPU=$$GET1^DIQ(50,DRUG,14.5)
S RXINFO=$G(^TMP("PS",$J,0)),$P(RXINFO,U,2)=$P($G(^("RXN",0)),U)
S $P(RXINFO,U,9)=$TR($G(^TMP("PS",$J,"P",0)),U,"~")
S PRVIEN=+$P(RXINFO,U,9)
S $P(RXINFO,U,10)=RX_"R;O"
S $P(RXINFO,U,13)=$$GET1^DIQ(59,+$$LOC^APSPFNC2(+ORDID),.01)
S $P(RXINFO,U,14)=$$NDCVAL^APSPFUNC(RX)
S RRIEN=$$VALUE^ORCSAVE2(+ORDID,"SSRREQIEN")
S SSNUM=$$GET1^DIQ(9009033.91,RRIEN,.1)
D:$G(ADDHDR) ADD($$TAG("Prescription"))
D ADD($$TAG("PatientName",2,$$GET1^DIQ(2,DFN,.01)))
D BLDPT^BEHORXF2(DFN,RX)
D BLDPTADD^BEHORXF2(DFN)
D DATA^BEHORXF2(DFN)
D ADD($$TAG("Chronic",2,$$GET1^DIQ(52,RX,9999999.02)))
D ADD($$TAG("DAW",2,$S($$GETDAW^BEHORXFN(ORDID):"Yes",1:"No")))
D ADD($$TAG("DaysSupply",2,$P(RXINFO,U,7)))
D ADD($$TAG("DrugName",2,$P(RXINFO,U)))
D ADD($$TAG("IndCode",2,$P($$GETIND^BEHORXFN(ORDID),"~")))
D ADD($$TAG("IndText",2,$P($$GETIND^BEHORXFN(ORDID),"~",2)))
D ADD($$TAG("EnteredBy",2,$$GET1^DIQ(100,ORDID,3)))
D ADD($$TAG("OrderLocation",2,$$GET1^DIQ(100,ORDID,6)))
D ADD($$TAG("DEA",2,$$GET1^DIQ(50,$$GET1^DIQ(52,RX,6,"I"),3)))
D ADD($$TAG("Instruct",2,$$RXINSTR()))
D ADD($$TAG("NotesToPharmacist",2,$$ORDCOM(ORDID)))
D ADD($$TAG("IssueDate",2,$$FMTE^XLFDT($P(RXINFO,U,5),9)))
;D ADD($$TAG("LastFill",2,$$FMTE^XLFDT($P(RXINFO,U,12),9)))
;D ADD($$TAG("NDC",2,$P(RXINFO,U,14)))
;MakeTag('OrderAction',OrderAction);
D ADD($$TAG("OrderID",2,ORDID))
;D ADD($$TAG("PharmID",2,$P(RXINFO,U,10)))
D ADD($$TAG("OrderableItem",2,$$GET1^DIQ(101.43,$$VALUE^ORCSAVE2(ORDID,"ORDERABLE"),.01)))
D ADD($$TAG("PharmSite",2,$P(RXINFO,U,13))) ;name
D ADD($$TAG("Provider",2,$P($P(RXINFO,U,9),"~",2)))
D PROV^BEHORXF2(PRVIEN,ORDID)
S QTY=$P(RXINFO,U,8),QTYW=$$WRDFMT^APSPFNC7(QTY)
;D ADD($$TAG("Quantity",2,QTY_"("_QTYW_")"))
; DKA 2013-02-25 artf13536 Don't add parentheses if Quantity-In-Words is blank for decimal value.
D ADD($$TAG("Quantity",2,QTY_$S(QTYW="":"",1:"("_QTYW_")")_" "_DISPU))
D ADD($$TAG("Refills",2,$P(RXINFO,U,4)))
;D ADD($$TAG("RxNum",2,$P(RXINFO,U,2)))
D ADD($$TAG("RxNorm",2,$$GETRXNRM^BEHORXFN(ORDID,RX)))
I SSNUM'="" D ADD($$TAG("RxRefNum",2,SSNUM))
I SSNUM'="" D
.N Z,ZZZ,RSCH
.S RSCH=$$GET^XPAR("ALL","APSP AUTO RX SCHEDULE RESTRICT")
.S Z=$$ISSCH^APSPFNC2(DRUG,RSCH)
.Q:Z=0
.S ZZZ=$$GET1^DIQ(9009033.91,RRIEN,.03,"I")
.I ZZZ=5 D ADD($$TAG("C2Msg",2,"This is in response to an electronic refill renewal request for a controlled substance."))
;D ADD($$TAG("Status",2,$P(RXINFO,U,6)))
;D ADD($$TAG("StopDate",2,$$FMTE^XLFDT($P(RXINFO,U,3),9)))
D ADD($$TAG("ProcessState",2,$$PSTATE^BEHORXFN(RX)))
D ADD($$TAG("NeedsReason",2,$$GETNDRSN($$PSTATE^BEHORXFN(RX))))
S DRG=$$GET1^DIQ(52,RX,6,"I")
S LNAME=""
S LNAME=$$GET1^DIQ(50,DRG,9999999.352)
D ADD($$TAG("TransmittedDrugName",2,$S(LNAME'="":LNAME,1:$$GET1^DIQ(52,RX,6))))
D ADD($$TAG("Date_Time",2,$$XMTDATE^BEHORXRT(RX)))
S INI=$$GET1^DIQ(44,$$GET1^DIQ(52,RX,5,"I"),3,"I")
I INI="" D
.S RXDIV=$$GET1^DIQ(52,RX,20,"I")
.S INI=$$GET1^DIQ(44,$$GET1^DIQ(9009033,RXDIV,317,"I"),3,"I")
D INST2^BEHORXRT(INI)
S PHMI=$$GET1^DIQ(52,RX,9999999.24,"I")
D PHARM2^BEHORXRT(PHMI)
D:$G(ADDHDR) ADD($$TAG("Prescription",1))
Q
; Add XML record for an order
ORDXML(ORD) ;EP-
N POF,DEA,PRVIEN,QTY,QTYW,INI,DRUG,DISPU
D ADD($$TAG("Order"))
D ADD($$TAG("PatientName",2,$$GET1^DIQ(2,DFN,.01)))
D BLDPT^BEHORXF2(DFN)
D BLDPTADD^BEHORXF2(DFN)
D DATA^BEHORXF2(DFN)
D ADD($$TAG("Chronic",2,$S($$VALUE^ORCSAVE2(ORD,"CMF")["Y":"True",1:"False")))
D ADD($$TAG("DAW",2,$S($$VALUE^ORCSAVE2(ORD,"DAW"):"Yes",1:"No")))
D ADD($$TAG("DaysSupply",2,$$VALUE^ORCSAVE2(ORD,"SUPPLY")))
D ADD($$TAG("Quantity",2,$$VALUE^ORCSAVE2(ORD,"QTY")))
D ADD($$TAG("DrugName",2,$$GET1^DIQ(50,$$VALUE^ORCSAVE2(ORD,"DRUG"),.01)))
D ADD($$TAG("IndCode",2,$P($$GETIND^BEHORXFN(ORD),"~")))
D ADD($$TAG("IndText",2,$P($$GETIND^BEHORXFN(ORD),"~",2)))
D ADD($$TAG("EnteredBy",2,$$GET1^DIQ(100,ORD,3)))
D ADD($$TAG("OrderLocation",2,$$GET1^DIQ(100,ORD,6)))
;D DEACLS^APSPFNC2(.DEA,ORD,"2")
S DRUG=$$VALUE^ORCSAVE2(ORD,"DRUG")
D ADD($$TAG("DEA",2,$$GET1^DIQ(50,DRUG,3)))
D ADD($$TAG("OrderableItem",2,$$GET1^DIQ(101.43,$$VALUE^ORCSAVE2(ORD,"ORDERABLE"),.01)))
D ADD($$TAG("NotesToPharmacist",2,$$ORDCOM(ORD)))
S POF=$$POFIEN(ORD)
I POF D
.D ADD($$TAG("Provider",2,$$GET1^DIQ(52.41,POF,5)))
.D ADD($$TAG("Instruct",2,$$ORDINSTR(POF)))
.D ADD($$TAG("IssueDate",2,$$FMTE^XLFDT($$GET1^DIQ(52.41,POF,6,"I"))))
.;D ADD($$TAG("LastFill",2,$$FMTE^XLFDT($P(RXINFO,U,12),9)))
.;D ADD($$TAG("NDC",2,$P(RXINFO,U,14)))
.;MakeTag('OrderAction',OrderAction);
.D ADD($$TAG("OrderID",2,ORD))
.;D ADD($$TAG("PharmID",2,$P(RXINFO,U,10)))
.;D ADD($$TAG("PharmSite",2,$P(RXINFO,U,13))) ;ien
.S PRVIEN=$$GET1^DIQ(52.41,POF,5,"I")
.D PROV^BEHORXF2(PRVIEN,ORD)
.S QTY=$$GET1^DIQ(52.41,POF,12),QTYW=$$WRDFMT^APSPFNC7(QTY)
.S DISPU=$$GET1^DIQ(50,$$VALUE^ORCSAVE2(ORD,"DRUG"),14.5)
.;D ADD($$TAG("Quantity",2,QTY_"("_QTYW_")"))
.; DKA 2013-02-25 artf13536 Don't add parentheses if Quantity-In-Words is blank for decimal value.
.D ADD($$TAG("Quantity",2,QTY_$S(QTYW="":"",1:"("_QTYW_")")_" "_DISPU))
.D ADD($$TAG("Refills",2,$$GET1^DIQ(52.41,POF,13)))
.D ADD($$TAG("RxNorm",2,$$RXNORM^BEHORXF2(POF)))
.;D ADD($$TAG("Status",2,$P(RXINFO,U,6)))
.;D ADD($$TAG("StopDate",2,$$FMTE^XLFDT($P(RXINFO,U,3),9)))
.;D ADD($$TAG("ProcessState",2,$$PSTATE^BEHORXFN(RX)))
S INI=$$GET1^DIQ(44,$P($$GET1^DIQ(100,ORD,6,"I"),";",1),3,"I")
D INST2^BEHORXRT(INI)
S PHMI=$$VALUE^ORCSAVE2(+ORD,"PHARMACY")
D PHARM2^BEHORXRT(PHMI)
D ADD($$TAG("Order",1))
Q
; Returns instruction array
RXINSTR() ;EP-
N Y,INST,RET,I
S RET="",Y=0
;S INST(1)=" "_$P(RXINFO,U),Y=1
;S:$L($P(RXINFO,U,8)) INST(1)=INST(1)_" Qty: "_$P(RXINFO,U,8)
;S:$L($P(RXINFO,U,7)) INST(1)=INST(1)_" for "_$P(RXINFO,U,7)_" days"
S I=0
F S I=$O(^TMP("PS",$J,"SIG",I)) Q:'I D
.S Y=Y+1,INST(Y)=^TMP("PS",$J,"SIG",I,0)
;S INST(2)=" Sig: "_$G(INST(2))
;F I=3:1:Y S INST(I)=" "_INST(I)
F I=1:1:Y S RET=RET_INST(I)
Q RET
ORDINSTR(POF) ;EP-
N RET,LP,SIG
S RET=""
S LP=0 F S LP=$O(^PS(52.41,POF,"SIG",LP)) Q:'LP D
.S SIG=^PS(52.41,POF,"SIG",LP,0)
.S RET=$S($L(RET):RET_" "_SIG,1:SIG)
Q RET
; Return Order Comments
ORDCOM(ORD) ;EP-
N RET,LP,VAL,ID
S RET=""
S ID=$O(^OR(100,ORD,4.5,"ID","COMMENT",0))
I ID D
.S LP=0 F S LP=$O(^OR(100,ORD,4.5,ID,2,LP)) Q:'LP D
..S VAL=$G(^OR(100,ORD,4.5,ID,2,LP,0))
..S RET=$S($L(RET):RET_" "_VAL,1:VAL)
Q RET
; Add data to array
ADD(VAL) ;EP-
S CNT=CNT+1
S @DATA@(CNT)=VAL
Q
; Add XML Header to return array
XMLHDR ;
D ADD("<?xml version=""1.0"" ?>")
Q
; Returns formatted tag
; Input: TAG - Name of Tag
; TYPE - (-1) = empty 0 =start <tag> 1 =end </tag> 2 = start -VAL - end
; VAL - data value
TAG(TAG,TYPE,VAL) ;EP -
S TYPE=$G(TYPE,0)
S:$L($G(VAL)) VAL=$$SYMENC^MXMLUTL(VAL)
I TYPE<0 Q "<"_TAG_"/>" ;empty
E I TYPE=1 Q "</"_TAG_">"
E I TYPE=2 Q "<"_TAG_">"_$G(VAL)_"</"_TAG_">"
Q "<"_TAG_">"
; Return IEN to Pending Order File (52.41)
POFIEN(ORD) ;EP-
N PKGID
S PKGID=$G(^OR(100,ORD,4))
Q:PKGID'["S" 0
S PKGID=+PKGID
Q:'PKGID!('$D(^PS(52.41,PKGID,0))) 0
Q PKGID
; Return temp global reference
TMPGBL() N GBL
S GBL=$NA(^TMP("BEHORXF1",$J))
K @GBL
Q GBL
; Returns NEEDREASON value
GETNDRSN(PROCESS) ;EP-
Q $S(PROCESS="P":"True",PROCESS="E":"True",1:"False")
; RPC: Return a set of hospital locations
HOSPLOC(DATA,FROM,DIR,MAX,TYPE,START,END) ;EP
N IEN,CNT,APT
S FROM=$G(FROM),DIR=$G(DIR,1),MAX=$G(MAX,44),TYPE=$G(TYPE),CNT=0
S START=$G(START)\1,END=$G(END)\1
S:'END END=START
F S FROM=$O(^SC("B",FROM),DIR),IEN="" Q:FROM="" D Q:CNT'<MAX
.F S IEN=$O(^SC("B",FROM,IEN),DIR) Q:'IEN D
..I $$ACTLOC(IEN) D
...I $L(TYPE) Q:$P(^SC(IEN,0),U,3)'[TYPE
...;I START S APT=$O(^SC(IEN,"S",START-.1))\1 Q:'APT!(APT>END)
...S CNT=CNT+1,DATA(CNT)=IEN_U_$P(^SC(IEN,0),U)
Q
; Returns true if active hospital location
; LOC = IEN of hospital location
; DAT = optional date to check (defaults to today)
ACTLOC(LOC,DAT) ;PEP - Is active location?
N D0,X
S DAT=$G(DAT,DT)\1
S X=$G(^SC(LOC,0))
Q:'$L(X) 0 ; Screen nonexistent entries
S X=$G(^SC(LOC,"I"))
Q:'X 1 ; No inactivate date
Q:DAT'<$P(X,U)&($P(X,U,2)=""!(DAT<$P(X,U,2))) 0 ; Check reactivate date
Q 1 ; Must still be active
BEHORXF1 ;MSC/IND/PLS - XML Support for Pharmacy Rx Gen service ;22-Aug-2013 10:07;DU
+1 ;;1.1;BEH COMPONENTS;**009007,009009,009010**;Sep 18, 2007
+2 ;=================================================================
+3 ; RPC: BEHORXF1 SFMTXML
+4 ; Save prescription xml format
+5 ;
SFMTXML(DATA,NAME,VAL,ENT) ;EP-
+1 SET VAL=NAME
+2 IF $DATA(VAL)'=11
SET VAL(1,0)=""
+3 DO EN^XPAR(ENT,"BEHORX PRINT FORMATS",NAME,.VAL,.DATA)
+4 QUIT
+5 ; Creates log entry for Order for Signature prints
+6 ; Input: ORIFN - IEN to Order File (100)
+7 ;
UPTLOG(DATA,ORIFN,ACTION,ARY) ;EP-
+1 NEW FDA,ERR,FN,IENS,USR
+2 SET IENS="+1,"
+3 SET USR=$SELECT($GET(ARY("USER")):ARY("USER"),1:DUZ)
+4 SET DATA=0
+5 SET FN=90460.08
+6 IF ACTION'=2
SET ARY("COM")="Order for signature printed on "_ARY("DEV")_"."
+7 SET FDA(FN,IENS,.01)=$$NOW^XLFDT()
+8 SET FDA(FN,IENS,.02)=ORIFN
+9 SET FDA(FN,IENS,.03)=USR
+10 SET FDA(FN,IENS,.04)=$SELECT(ACTION=2:"R",1:"P")
+11 SET FDA(FN,IENS,1)=$GET(ARY("DEV"))
+12 SET FDA(FN,IENS,2)=$GET(ARY("COM"))
+13 DO UPDATE^DIE(,"FDA",,"ERR")
+14 IF '$DATA(ERR)
SET DATA=1
+15 IF '$TEST
SET DATA="0^Unable to update log"
+16 QUIT
+17 ; Validate Queue List
VALQUE(DATA,ORLST) ;EP-
+1 ;CHECK SIGNATURE STATUS (<>2), oRDER STATUS ; EITHER PENDING or ACTIVE
+2 ; Package = OUTPATIENT PHARMACY
+3 ; Dialog = PSO OERR
+4 ; To = OUTPATIENT MEDICATIONS
+5 ; Status = Active = prescription must have AUTOFINISHED field set to YES.
+6 ; Pending = OI must be CII
+7 ; Who = Logged in user (DUZ)
+8 ; CII = OI is CII
+9 ; Type = Outpatient
+10 SET DATA=$$TMPGBL
+11 NEW ID,LP,PKG,DLG,NOA,STS,WHO,TO,PSIFN,TYPE,ATF,CNT,ADD,OI
+12 SET CNT=0
+13 SET LP=0
FOR
SET LP=$ORDER(ORLST(LP))
IF LP=""
QUIT
Begin DoDot:1
+14 SET ADD=0
SET ID=ORLST(LP)
+15 SET PKG=$$GET1^DIQ(100,+ID,12)="OUTPATIENT PHARMACY"
+16 SET DLG=$$GET1^DIQ(100,+ID,2)="PSO OERR"
+17 SET TO=$$GET1^DIQ(100,+ID,23)="OUTPATIENT MEDICATIONS"
+18 SET TYPE=$PIECE($GET(^OR(100,+ID,0)),U,12)="O"
+19 IF 'PKG!'DLG!'TO!'TYPE
QUIT
+20 SET PSIFN=+$GET(^OR(100,+ID,4))
+21 IF 'PSIFN
QUIT
+22 SET STS=$$GET1^DIQ(100,+ID,5)
+23 SET OI=$$VALUE^ORCSAVE2(+ID,"ORDERABLE")
+24 IF STS="ACTIVE"
Begin DoDot:2
+25 IF ('$$ERXOI^APSPFNC6(OI,"2345"))&('$$GET^XPAR("ALL","BEHORX AUTO-RECEIPT"))&(+$PIECE($GET(^PSRX(PSIFN,999999921)),U,4))
QUIT
+26 SET ATF=$PIECE($GET(^PSRX(PSIFN,999999921)),U,3)
+27 IF ATF
DO ADDID(ID)
End DoDot:2
+28 IF '$TEST
IF STS="PENDING"
Begin DoDot:2
+29 IF '$$ERXOI^APSPFNC6(OI,"2"_$SELECT($$GET^XPAR("ALL","BEHORX PRINT QUEUE C35")
QUIT
+30 DO ADDID(ID)
End DoDot:2
End DoDot:1
+31 QUIT
ADDID(ID) ;EP-
+1 SET CNT=CNT+1
+2 SET @DATA@(CNT)=ID
+3 QUIT
+4 ; Return XML representation of Orders in array
ORDRSXML(DATA,ORDARY,DFN) ;EP-
+1 NEW CNT,LP
+2 SET CNT=0
+3 SET DATA=$$TMPGBL
+4 DO XMLHDR
+5 DO ORDSXML(.ORDARY)
+6 QUIT
+7 ; Return XML representation of Prescription
MEDXML(DATA,ORDERID,DFN,XTRA) ;EP-
+1 NEW CNT,PSIFN,LP
+2 SET CNT=0
+3 SET DATA=$$TMPGBL
+4 DO XMLHDR
+5 DO ADD($$TAG("Prescriptions",0))
+6 SET PSIFN=$$GETPSIFN^BEHORXFN(ORDERID)
+7 IF $DATA(XTRA)
Begin DoDot:1
+8 SET LP=""
FOR
SET LP=$ORDER(XTRA(LP))
IF LP=""
QUIT
Begin DoDot:2
+9 DO ADD(XTRA(LP))
End DoDot:2
End DoDot:1
+10 DO RXXML(PSIFN,+ORDERID,1)
+11 DO ADD($$TAG("Prescriptions",1))
+12 QUIT
+13 ; Return XML representation of Prescriptions in array
MEDSXML(DATA,ORDARY,DFN) ;EP-
+1 NEW CNT,LP,ID
+2 SET CNT=0
+3 SET DATA=$$TMPGBL
+4 DO XMLHDR
+5 DO ADD($$TAG("Prescriptions",0))
+6 SET LP=0
FOR
SET LP=$ORDER(ORDARY(LP))
IF LP=""
QUIT
Begin DoDot:1
+7 SET ID=+ORDARY(LP)
+8 SET PSIFN=$$GETPSIFN^BEHORXFN(ID)
+9 IF PSIFN'=+PSIFN
QUIT
+10 DO RXXML(PSIFN,ID,1)
End DoDot:1
+11 DO ADD($$TAG("Prescriptions",1))
+12 QUIT
+13 ; Return XML representation for Order, Prescription and/or Receipt
BATCHXML(DATA,ORDARY,DFN) ;EP-
+1 NEW CNT,LP,PSIFN
+2 SET CNT=0
+3 SET DATA=$$TMPGBL
+4 DO XMLHDR
+5 DO ADD($$TAG("Batch",0))
+6 DO RXSXML(.ORDARY)
+7 DO ORDSXML(.ORDARY)
+8 IF $$GET^XPAR("ALL","BEHORX AUTO-RECEIPT")
DO RECSXML(.ORDARY)
+9 DO ADD($$TAG("Batch",1))
+10 QUIT
RXSXML(ORDARY) ;EP-Build Prescription xml
+1 NEW ID
+2 DO ADD($$TAG("Prescriptions",0))
+3 SET LP=0
FOR
SET LP=$ORDER(ORDARY(LP))
IF LP=""
QUIT
Begin DoDot:1
+4 SET ID=+ORDARY(LP)
+5 SET PSIFN=$$GETPSIFN^BEHORXFN(ID)
+6 IF $$ISA("RX",PSIFN)
Begin DoDot:2
+7 DO RXXML(PSIFN,ID,1)
End DoDot:2
End DoDot:1
+8 DO ADD($$TAG("Prescriptions",1))
+9 QUIT
ORDSXML(ORDARY) ;EP-Build Order XML
+1 NEW ID
+2 DO ADD($$TAG("Orders",0))
+3 SET LP=0
FOR
SET LP=$ORDER(ORDARY(LP))
IF LP=""
QUIT
Begin DoDot:1
+4 SET ID=+ORDARY(LP)
+5 IF $$ISA("OR",ID)
Begin DoDot:2
+6 DO ORDXML(ID)
End DoDot:2
End DoDot:1
+7 DO ADD($$TAG("Orders",1))
+8 QUIT
RECSXML(ORDARY) ;EP-Build Receipt XML
+1 NEW ID
+2 NEW PNM
+3 SET PNM=$$GET1^DIQ(2,DFN,.01)
+4 SET PNM=$PIECE(PNM,",",2)_" "_$PIECE(PNM,",")
+5 DO ADD($$TAG("Transactions",0))
+6 DO ADD($$TAG("PatientName",2,PNM))
+7 DO BLDPT^BEHORXF2(DFN,"")
+8 DO BLDPTADD^BEHORXF2(DFN)
+9 DO DATA^BEHORXF2(DFN)
+10 SET LP=0
FOR
SET LP=$ORDER(ORDARY(LP))
IF LP=""
QUIT
Begin DoDot:1
+11 SET ID=+ORDARY(LP)
+12 SET PSIFN=$$GETPSIFN^BEHORXFN(+ORDARY(LP))
+13 IF $$ISA("RC",PSIFN)
Begin DoDot:2
+14 DO RECEIPT^BEHORXRT(PSIFN,ID)
End DoDot:2
End DoDot:1
+15 DO ADD($$TAG("Transactions",1))
+16 QUIT
ISA(TYPE,ID) ;EP-
+1 NEW RET,PKUP,ORDID
+2 SET RET=0
+3 IF TYPE="RX"
Begin DoDot:1
+4 ;ID=RX IEN
+5 ;ATF,PHM,ACTIVE AND NOT PSTATE="E" - PHM not required if PICKUP is a 'P'
+6 SET ORDID=+$$GET1^DIQ(52,ID,39.3,"I")
+7 SET PKUP=$$VALUE^ORCSAVE2(ORDID,"PICKUP")
+8 SET RET=''$$GET1^DIQ(52,ID,9999999.23,"I")&($SELECT(PKUP="P":1,1:''$$GET1^DIQ(52,ID,9999999.24,"I")))&('$$GET1^DIQ(52,ID,100,"I"))&($$PSTATE^BEHORXFN(ID)'="E")
End DoDot:1
+9 IF '$TEST
IF TYPE="OR"
Begin DoDot:1
+10 ;ID=ORDER IEN
+11 SET RET=$$GET1^DIQ(100,+ID,5)="PENDING"
End DoDot:1
+12 IF '$TEST
IF TYPE="RC"
Begin DoDot:1
+13 ;ID=RX IEN
+14 SET RET=$$PSTATE^BEHORXFN(ID)="E"
End DoDot:1
+15 QUIT RET
+16 ; Add XML record for a prescription
RXXML(RX,ORDID,ADDHDR) ;EP-
+1 NEW RXINFO,PRVIEN,QTY,QTYW,RRIEN,SSNUM,INI,PHMI,DRG,LNAME,DRUG,DISPU,RXDIV
+2 KILL ^TMP("PS",$JOB)
+3 DO OEL^PSOORRL(DFN,RX)
+4 SET DRUG=$$GET1^DIQ(52,RX,6,"I")
+5 SET DISPU=$$GET1^DIQ(50,DRUG,14.5)
+6 SET RXINFO=$GET(^TMP("PS",$JOB,0))
SET $PIECE(RXINFO,U,2)=$PIECE($GET(^("RXN",0)),U)
+7 SET $PIECE(RXINFO,U,9)=$TRANSLATE($GET(^TMP("PS",$JOB,"P",0)),U,"~")
+8 SET PRVIEN=+$PIECE(RXINFO,U,9)
+9 SET $PIECE(RXINFO,U,10)=RX_"R;O"
+10 SET $PIECE(RXINFO,U,13)=$$GET1^DIQ(59,+$$LOC^APSPFNC2(+ORDID),.01)
+11 SET $PIECE(RXINFO,U,14)=$$NDCVAL^APSPFUNC(RX)
+12 SET RRIEN=$$VALUE^ORCSAVE2(+ORDID,"SSRREQIEN")
+13 SET SSNUM=$$GET1^DIQ(9009033.91,RRIEN,.1)
+14 IF $GET(ADDHDR)
DO ADD($$TAG("Prescription"))
+15 DO ADD($$TAG("PatientName",2,$$GET1^DIQ(2,DFN,.01)))
+16 DO BLDPT^BEHORXF2(DFN,RX)
+17 DO BLDPTADD^BEHORXF2(DFN)
+18 DO DATA^BEHORXF2(DFN)
+19 DO ADD($$TAG("Chronic",2,$$GET1^DIQ(52,RX,9999999.02)))
+20 DO ADD($$TAG("DAW",2,$SELECT($$GETDAW^BEHORXFN(ORDID):"Yes",1:"No")))
+21 DO ADD($$TAG("DaysSupply",2,$PIECE(RXINFO,U,7)))
+22 DO ADD($$TAG("DrugName",2,$PIECE(RXINFO,U)))
+23 DO ADD($$TAG("IndCode",2,$PIECE($$GETIND^BEHORXFN(ORDID),"~")))
+24 DO ADD($$TAG("IndText",2,$PIECE($$GETIND^BEHORXFN(ORDID),"~",2)))
+25 DO ADD($$TAG("EnteredBy",2,$$GET1^DIQ(100,ORDID,3)))
+26 DO ADD($$TAG("OrderLocation",2,$$GET1^DIQ(100,ORDID,6)))
+27 DO ADD($$TAG("DEA",2,$$GET1^DIQ(50,$$GET1^DIQ(52,RX,6,"I"),3)))
+28 DO ADD($$TAG("Instruct",2,$$RXINSTR()))
+29 DO ADD($$TAG("NotesToPharmacist",2,$$ORDCOM(ORDID)))
+30 DO ADD($$TAG("IssueDate",2,$$FMTE^XLFDT($PIECE(RXINFO,U,5),9)))
+31 ;D ADD($$TAG("LastFill",2,$$FMTE^XLFDT($P(RXINFO,U,12),9)))
+32 ;D ADD($$TAG("NDC",2,$P(RXINFO,U,14)))
+33 ;MakeTag('OrderAction',OrderAction);
+34 DO ADD($$TAG("OrderID",2,ORDID))
+35 ;D ADD($$TAG("PharmID",2,$P(RXINFO,U,10)))
+36 DO ADD($$TAG("OrderableItem",2,$$GET1^DIQ(101.43,$$VALUE^ORCSAVE2(ORDID,"ORDERABLE"),.01)))
+37 ;name
DO ADD($$TAG("PharmSite",2,$PIECE(RXINFO,U,13)))
+38 DO ADD($$TAG("Provider",2,$PIECE($PIECE(RXINFO,U,9),"~",2)))
+39 DO PROV^BEHORXF2(PRVIEN,ORDID)
+40 SET QTY=$PIECE(RXINFO,U,8)
SET QTYW=$$WRDFMT^APSPFNC7(QTY)
+41 ;D ADD($$TAG("Quantity",2,QTY_"("_QTYW_")"))
+42 ; DKA 2013-02-25 artf13536 Don't add parentheses if Quantity-In-Words is blank for decimal value.
+43 DO ADD($$TAG("Quantity",2,QTY_$SELECT(QTYW="":"",1:"("_QTYW_")")_" "_DISPU))
+44 DO ADD($$TAG("Refills",2,$PIECE(RXINFO,U,4)))
+45 ;D ADD($$TAG("RxNum",2,$P(RXINFO,U,2)))
+46 DO ADD($$TAG("RxNorm",2,$$GETRXNRM^BEHORXFN(ORDID,RX)))
+47 IF SSNUM'=""
DO ADD($$TAG("RxRefNum",2,SSNUM))
+48 IF SSNUM'=""
Begin DoDot:1
+49 NEW Z,ZZZ,RSCH
+50 SET RSCH=$$GET^XPAR("ALL","APSP AUTO RX SCHEDULE RESTRICT")
+51 SET Z=$$ISSCH^APSPFNC2(DRUG,RSCH)
+52 IF Z=0
QUIT
+53 SET ZZZ=$$GET1^DIQ(9009033.91,RRIEN,.03,"I")
+54 IF ZZZ=5
DO ADD($$TAG("C2Msg",2,"This is in response to an electronic refill renewal request for a controlled substance."))
End DoDot:1
+55 ;D ADD($$TAG("Status",2,$P(RXINFO,U,6)))
+56 ;D ADD($$TAG("StopDate",2,$$FMTE^XLFDT($P(RXINFO,U,3),9)))
+57 DO ADD($$TAG("ProcessState",2,$$PSTATE^BEHORXFN(RX)))
+58 DO ADD($$TAG("NeedsReason",2,$$GETNDRSN($$PSTATE^BEHORXFN(RX))))
+59 SET DRG=$$GET1^DIQ(52,RX,6,"I")
+60 SET LNAME=""
+61 SET LNAME=$$GET1^DIQ(50,DRG,9999999.352)
+62 DO ADD($$TAG("TransmittedDrugName",2,$SELECT(LNAME'="":LNAME,1:$$GET1^DIQ(52,RX,6))))
+63 DO ADD($$TAG("Date_Time",2,$$XMTDATE^BEHORXRT(RX)))
+64 SET INI=$$GET1^DIQ(44,$$GET1^DIQ(52,RX,5,"I"),3,"I")
+65 IF INI=""
Begin DoDot:1
+66 SET RXDIV=$$GET1^DIQ(52,RX,20,"I")
+67 SET INI=$$GET1^DIQ(44,$$GET1^DIQ(9009033,RXDIV,317,"I"),3,"I")
End DoDot:1
+68 DO INST2^BEHORXRT(INI)
+69 SET PHMI=$$GET1^DIQ(52,RX,9999999.24,"I")
+70 DO PHARM2^BEHORXRT(PHMI)
+71 IF $GET(ADDHDR)
DO ADD($$TAG("Prescription",1))
+72 QUIT
+73 ; Add XML record for an order
ORDXML(ORD) ;EP-
+1 NEW POF,DEA,PRVIEN,QTY,QTYW,INI,DRUG,DISPU
+2 DO ADD($$TAG("Order"))
+3 DO ADD($$TAG("PatientName",2,$$GET1^DIQ(2,DFN,.01)))
+4 DO BLDPT^BEHORXF2(DFN)
+5 DO BLDPTADD^BEHORXF2(DFN)
+6 DO DATA^BEHORXF2(DFN)
+7 DO ADD($$TAG("Chronic",2,$SELECT($$VALUE^ORCSAVE2(ORD,"CMF")["Y":"True",1:"False")))
+8 DO ADD($$TAG("DAW",2,$SELECT($$VALUE^ORCSAVE2(ORD,"DAW"):"Yes",1:"No")))
+9 DO ADD($$TAG("DaysSupply",2,$$VALUE^ORCSAVE2(ORD,"SUPPLY")))
+10 DO ADD($$TAG("Quantity",2,$$VALUE^ORCSAVE2(ORD,"QTY")))
+11 DO ADD($$TAG("DrugName",2,$$GET1^DIQ(50,$$VALUE^ORCSAVE2(ORD,"DRUG"),.01)))
+12 DO ADD($$TAG("IndCode",2,$PIECE($$GETIND^BEHORXFN(ORD),"~")))
+13 DO ADD($$TAG("IndText",2,$PIECE($$GETIND^BEHORXFN(ORD),"~",2)))
+14 DO ADD($$TAG("EnteredBy",2,$$GET1^DIQ(100,ORD,3)))
+15 DO ADD($$TAG("OrderLocation",2,$$GET1^DIQ(100,ORD,6)))
+16 ;D DEACLS^APSPFNC2(.DEA,ORD,"2")
+17 SET DRUG=$$VALUE^ORCSAVE2(ORD,"DRUG")
+18 DO ADD($$TAG("DEA",2,$$GET1^DIQ(50,DRUG,3)))
+19 DO ADD($$TAG("OrderableItem",2,$$GET1^DIQ(101.43,$$VALUE^ORCSAVE2(ORD,"ORDERABLE"),.01)))
+20 DO ADD($$TAG("NotesToPharmacist",2,$$ORDCOM(ORD)))
+21 SET POF=$$POFIEN(ORD)
+22 IF POF
Begin DoDot:1
+23 DO ADD($$TAG("Provider",2,$$GET1^DIQ(52.41,POF,5)))
+24 DO ADD($$TAG("Instruct",2,$$ORDINSTR(POF)))
+25 DO ADD($$TAG("IssueDate",2,$$FMTE^XLFDT($$GET1^DIQ(52.41,POF,6,"I"))))
+26 ;D ADD($$TAG("LastFill",2,$$FMTE^XLFDT($P(RXINFO,U,12),9)))
+27 ;D ADD($$TAG("NDC",2,$P(RXINFO,U,14)))
+28 ;MakeTag('OrderAction',OrderAction);
+29 DO ADD($$TAG("OrderID",2,ORD))
+30 ;D ADD($$TAG("PharmID",2,$P(RXINFO,U,10)))
+31 ;D ADD($$TAG("PharmSite",2,$P(RXINFO,U,13))) ;ien
+32 SET PRVIEN=$$GET1^DIQ(52.41,POF,5,"I")
+33 DO PROV^BEHORXF2(PRVIEN,ORD)
+34 SET QTY=$$GET1^DIQ(52.41,POF,12)
SET QTYW=$$WRDFMT^APSPFNC7(QTY)
+35 SET DISPU=$$GET1^DIQ(50,$$VALUE^ORCSAVE2(ORD,"DRUG"),14.5)
+36 ;D ADD($$TAG("Quantity",2,QTY_"("_QTYW_")"))
+37 ; DKA 2013-02-25 artf13536 Don't add parentheses if Quantity-In-Words is blank for decimal value.
+38 DO ADD($$TAG("Quantity",2,QTY_$SELECT(QTYW="":"",1:"("_QTYW_")")_" "_DISPU))
+39 DO ADD($$TAG("Refills",2,$$GET1^DIQ(52.41,POF,13)))
+40 DO ADD($$TAG("RxNorm",2,$$RXNORM^BEHORXF2(POF)))
+41 ;D ADD($$TAG("Status",2,$P(RXINFO,U,6)))
+42 ;D ADD($$TAG("StopDate",2,$$FMTE^XLFDT($P(RXINFO,U,3),9)))
+43 ;D ADD($$TAG("ProcessState",2,$$PSTATE^BEHORXFN(RX)))
End DoDot:1
+44 SET INI=$$GET1^DIQ(44,$PIECE($$GET1^DIQ(100,ORD,6,"I"),";",1),3,"I")
+45 DO INST2^BEHORXRT(INI)
+46 SET PHMI=$$VALUE^ORCSAVE2(+ORD,"PHARMACY")
+47 DO PHARM2^BEHORXRT(PHMI)
+48 DO ADD($$TAG("Order",1))
+49 QUIT
+50 ; Returns instruction array
RXINSTR() ;EP-
+1 NEW Y,INST,RET,I
+2 SET RET=""
SET Y=0
+3 ;S INST(1)=" "_$P(RXINFO,U),Y=1
+4 ;S:$L($P(RXINFO,U,8)) INST(1)=INST(1)_" Qty: "_$P(RXINFO,U,8)
+5 ;S:$L($P(RXINFO,U,7)) INST(1)=INST(1)_" for "_$P(RXINFO,U,7)_" days"
+6 SET I=0
+7 FOR
SET I=$ORDER(^TMP("PS",$JOB,"SIG",I))
IF 'I
QUIT
Begin DoDot:1
+8 SET Y=Y+1
SET INST(Y)=^TMP("PS",$JOB,"SIG",I,0)
End DoDot:1
+9 ;S INST(2)=" Sig: "_$G(INST(2))
+10 ;F I=3:1:Y S INST(I)=" "_INST(I)
+11 FOR I=1:1:Y
SET RET=RET_INST(I)
+12 QUIT RET
ORDINSTR(POF) ;EP-
+1 NEW RET,LP,SIG
+2 SET RET=""
+3 SET LP=0
FOR
SET LP=$ORDER(^PS(52.41,POF,"SIG",LP))
IF 'LP
QUIT
Begin DoDot:1
+4 SET SIG=^PS(52.41,POF,"SIG",LP,0)
+5 SET RET=$SELECT($LENGTH(RET):RET_" "_SIG,1:SIG)
End DoDot:1
+6 QUIT RET
+7 ; Return Order Comments
ORDCOM(ORD) ;EP-
+1 NEW RET,LP,VAL,ID
+2 SET RET=""
+3 SET ID=$ORDER(^OR(100,ORD,4.5,"ID","COMMENT",0))
+4 IF ID
Begin DoDot:1
+5 SET LP=0
FOR
SET LP=$ORDER(^OR(100,ORD,4.5,ID,2,LP))
IF 'LP
QUIT
Begin DoDot:2
+6 SET VAL=$GET(^OR(100,ORD,4.5,ID,2,LP,0))
+7 SET RET=$SELECT($LENGTH(RET):RET_" "_VAL,1:VAL)
End DoDot:2
End DoDot:1
+8 QUIT RET
+9 ; Add data to array
ADD(VAL) ;EP-
+1 SET CNT=CNT+1
+2 SET @DATA@(CNT)=VAL
+3 QUIT
+4 ; Add XML Header to return array
XMLHDR ;
+1 DO ADD("<?xml version=""1.0"" ?>")
+2 QUIT
+3 ; Returns formatted tag
+4 ; Input: TAG - Name of Tag
+5 ; TYPE - (-1) = empty 0 =start <tag> 1 =end </tag> 2 = start -VAL - end
+6 ; VAL - data value
TAG(TAG,TYPE,VAL) ;EP -
+1 SET TYPE=$GET(TYPE,0)
+2 IF $LENGTH($GET(VAL))
SET VAL=$$SYMENC^MXMLUTL(VAL)
+3 ;empty
IF TYPE<0
QUIT "<"_TAG_"/>"
+4 IF '$TEST
IF TYPE=1
QUIT "</"_TAG_">"
+5 IF '$TEST
IF TYPE=2
QUIT "<"_TAG_">"_$GET(VAL)_"</"_TAG_">"
+6 QUIT "<"_TAG_">"
+7 ; Return IEN to Pending Order File (52.41)
POFIEN(ORD) ;EP-
+1 NEW PKGID
+2 SET PKGID=$GET(^OR(100,ORD,4))
+3 IF PKGID'["S"
QUIT 0
+4 SET PKGID=+PKGID
+5 IF 'PKGID!('$DATA(^PS(52.41,PKGID,0)))
QUIT 0
+6 QUIT PKGID
+7 ; Return temp global reference
TMPGBL() NEW GBL
+1 SET GBL=$NAME(^TMP("BEHORXF1",$JOB))
+2 KILL @GBL
+3 QUIT GBL
+4 ; Returns NEEDREASON value
GETNDRSN(PROCESS) ;EP-
+1 QUIT $SELECT(PROCESS="P":"True",PROCESS="E":"True",1:"False")
+2 ; RPC: Return a set of hospital locations
HOSPLOC(DATA,FROM,DIR,MAX,TYPE,START,END) ;EP
+1 NEW IEN,CNT,APT
+2 SET FROM=$GET(FROM)
SET DIR=$GET(DIR,1)
SET MAX=$GET(MAX,44)
SET TYPE=$GET(TYPE)
SET CNT=0
+3 SET START=$GET(START)\1
SET END=$GET(END)\1
+4 IF 'END
SET END=START
+5 FOR
SET FROM=$ORDER(^SC("B",FROM),DIR)
SET IEN=""
IF FROM=""
QUIT
Begin DoDot:1
+6 FOR
SET IEN=$ORDER(^SC("B",FROM,IEN),DIR)
IF 'IEN
QUIT
Begin DoDot:2
+7 IF $$ACTLOC(IEN)
Begin DoDot:3
+8 IF $LENGTH(TYPE)
IF $PIECE(^SC(IEN,0),U,3)'[TYPE
QUIT
+9 ;I START S APT=$O(^SC(IEN,"S",START-.1))\1 Q:'APT!(APT>END)
+10 SET CNT=CNT+1
SET DATA(CNT)=IEN_U_$PIECE(^SC(IEN,0),U)
End DoDot:3
End DoDot:2
End DoDot:1
IF CNT'<MAX
QUIT
+11 QUIT
+12 ; Returns true if active hospital location
+13 ; LOC = IEN of hospital location
+14 ; DAT = optional date to check (defaults to today)
ACTLOC(LOC,DAT) ;PEP - Is active location?
+1 NEW D0,X
+2 SET DAT=$GET(DAT,DT)\1
+3 SET X=$GET(^SC(LOC,0))
+4 ; Screen nonexistent entries
IF '$LENGTH(X)
QUIT 0
+5 SET X=$GET(^SC(LOC,"I"))
+6 ; No inactivate date
IF 'X
QUIT 1
+7 ; Check reactivate date
IF DAT'<$PIECE(X,U)&($PIECE(X,U,2)=""!(DAT<$PIECE(X,U,2)))
QUIT 0
+8 ; Must still be active
QUIT 1
