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

BEHORXF1.m

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