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

ORQ3.m

Go to the documentation of this file.
  1. ORQ3 ;SLC/RBD - Provider Role Tool APIs ;Nov 19, 2020@09:53:02
  1. ;;3.0;ORDER ENTRY/RESULTS REPORTING;**453**;Dec 17, 1997;Build 47
  1. ;
  1. Q
  1. ;
  1. EN(ORY,ORPRIEN,ORDT1,ORDT2) ; Get Qualifying Orders for Provider
  1. ;
  1. ; This RPC allows retrieval of Patients and Orders for which the
  1. ; Provider is the Ordering Provider and the Orders are Signed
  1. ;
  1. ; Input:
  1. ; ORY is the name of the return array
  1. ; ORPRIEN identifies the IEN of the Provider to retrieve Orders for
  1. ; ORDT1 identifies the start date to start looking from
  1. ; ORDT2 identifies the end date to stop looking once reached
  1. ; Output:
  1. ; Global ^TMP("ORPATRTN",$J,n) where n represents each record found
  1. ; starting with record "1"
  1. ; Contains data for Patient Name ^ Patient IEN ^ Order IEN ^
  1. ; Order Status ^ Order Date
  1. ;
  1. N CNT,DFN,OR0,ORIEN,OROBJ,ORPRXFRD,ORPTNM,ORSIGNED,ORTMPDT,ORXFERNM,VADM
  1. N ORT,ORTIN,ORTOU,ORTED,A,ORTRPR,ORTOUT,ORTODAY
  1. S ORTODAY=$P($$NOW^XLFDT,".")
  1. S:'$D(U) U="^" K ^TMP("ORPTINFO",$J),^TMP("ORPATRTN",$J)
  1. S ORY=$NA(^TMP("ORPATRTN",$J))
  1. ; Loop through Providers that are Ordering Providers for Orders that have been Signed
  1. S ORTMPDT=ORDT1,ORDT1=ORDT1-.01,ORDT2=ORDT2_".2359"
  1. F S ORDT1=$O(^OR(100,"EPRACDT",ORPRIEN,ORDT1)) Q:ORDT1>ORDT2 Q:ORDT1="" D
  1. . S ORIEN="" F S ORIEN=$O(^OR(100,"EPRACDT",ORPRIEN,ORDT1,ORIEN)) Q:ORIEN="" D
  1. .. S OR0=$G(^OR(100,ORIEN,0)) I OR0="" Q
  1. .. I $$ORDERER^ORQOR2(ORIEN)'=ORPRIEN Q ; skip if not Ord. Prv.
  1. .. S ORSIGNED=($P($G(^OR(100,+ORIEN,8,1,0)),U,4)'=2) Q:'ORSIGNED ; skip if Order not Signed
  1. .. ; if Old Provider already Transferred, skip
  1. .. S ORPRXFRD=0,ORXFERNM=0
  1. .. F S ORXFERNM=$O(^OR(100,ORIEN,11,ORXFERNM)) Q:'ORXFERNM D Q:ORPRXFRD
  1. ... N A
  1. ... S A=$G(^OR(100,ORIEN,11,ORXFERNM,0))
  1. ... I $P(A,U,2)=ORPRIEN,$P(A,"^")'>ORTODAY S ORPRXFRD=1 Q
  1. .. Q:ORPRXFRD=1 S OROBJ=$P(OR0,U,2) Q:OROBJ'["DPT("
  1. .. S DFN=+OROBJ D OERR^VADPT S ORPTNM=$G(VADM(1)) Q:ORPTNM=""
  1. .. S ^TMP("ORPTINFO",$J,ORPTNM,DFN,ORIEN)=""
  1. ; Now order through Transferred To Provider index for situation where he/she has
  1. ; to Transfer Order to a third Provider (or fourth, etc.) ... only allow last entry
  1. ; from ORDER TRANSFERS multiple to be used though.
  1. S ORDT1=ORTMPDT
  1. F S ORDT1=$O(^OR(100,"EPRTRDT",ORPRIEN,ORDT1)) Q:ORDT1="" Q:ORDT1>ORDT2 D
  1. . S ORIEN="" F S ORIEN=$O(^OR(100,"EPRTRDT",ORPRIEN,ORDT1,ORIEN)) Q:ORIEN="" D
  1. .. S OR0=$G(^OR(100,ORIEN,0)) I OR0="" Q
  1. .. S ORPRXFRD=0,ORXFERNM=" ",ORINC=0
  1. .. F S ORXFERNM=$O(^OR(100,ORIEN,11,ORXFERNM),-1) Q:'ORXFERNM D Q:ORPRXFRD Q:ORINC
  1. ... N A
  1. ... S A=$G(^OR(100,ORIEN,11,ORXFERNM,0))
  1. ... I $P(A,U,2)=ORPRIEN,$P(A,"^")'>ORTODAY S ORPRXFRD=1 Q
  1. ... I $P(A,"^",3)=ORPRIEN S ORINC=1
  1. .. Q:ORPRXFRD=1 S OROBJ=$P(OR0,U,2) Q:OROBJ'["DPT("
  1. .. S DFN=+OROBJ D OERR^VADPT S ORPTNM=$G(VADM(1)) Q:ORPTNM=""
  1. .. S ^TMP("ORPTINFO",$J,ORPTNM,DFN,ORIEN)=""
  1. ; Put in Patient Name, Patient IEN, & Order IEN order to return to GUI
  1. S CNT=0,ORPTNM="" F S ORPTNM=$O(^TMP("ORPTINFO",$J,ORPTNM)) Q:ORPTNM="" D
  1. . N A,ORDDT,ORPDUZ,ORXFD0
  1. . S DFN="" F S DFN=$O(^TMP("ORPTINFO",$J,ORPTNM,DFN)) Q:DFN="" D
  1. .. S ORIEN="" F S ORIEN=$O(^TMP("ORPTINFO",$J,ORPTNM,DFN,ORIEN)) Q:ORIEN="" D
  1. ... S CNT=CNT+1
  1. ... S A=$O(^OR(100,ORIEN,8,"C","NW","")) Q:'A S ORDDT=$P($G(^OR(100,ORIEN,8,A,0)),"^") I ORDDT="" S ORDDT=$P($G(^OR(100,ORIEN,0)),"^",7)
  1. ... S ^TMP("ORPATRTN",$J,CNT)=ORPTNM_U_DFN_U_ORIEN_U_$P($$STATUS^ORQOR2(ORIEN),U,2)_U_$$FMTE^XLFDT(ORDDT)_"^"
  1. ... S (ORT,ORTIN,ORTOU,ORTED,ORTRPR,ORPDUZ,ORXFD0)=""
  1. ... I $D(^OR(100,ORIEN,11)) D
  1. .... N ORXFN,ORTS
  1. .... S ORXFN=" ",ORTS=0
  1. .... F S ORXFN=$O(^OR(100,ORIEN,11,ORXFN),-1) Q:'ORXFN D Q:ORTS
  1. ..... S A=$G(^OR(100,ORIEN,11,ORXFN,0))
  1. ..... I $P(A,"^",3)=ORPRIEN,$P(A,"^")'>ORTODAY S ORT=3,ORPDUZ=$P(A,"^",2),ORXFD0=A
  1. ..... I $P(A,"^",3)=ORPRIEN,$P(A,"^")>ORTODAY S ORT=2,ORPDUZ=$P(A,"^",2),ORXFD0=A,ORTS=1
  1. ..... I $P(A,"^",2)=ORPRIEN,$P(A,"^")>ORTODAY S ORT=1,ORPDUZ=$P(A,"^",3),ORXFD0=A,ORTS=1
  1. .... S ORTED=$P(ORXFD0,"^") ;I $P(ORXFD0,"^")]"" S ORTED=$$FMTE^XLFDT($P(ORXFD0,"^"))
  1. .... S ORTRPR=$$GET1^DIQ(200,ORPDUZ,.01,"E")
  1. .... S ^TMP("ORPATRTN",$J,CNT)=^TMP("ORPATRTN",$J,CNT)_ORT_"^"_ORTED_"^"_ORTRPR_"^"_ORPDUZ
  1. K ^TMP("ORPTINFO",$J)
  1. Q
  1. ;
  1. XFER(RESULTS,LST) ; Transfer Orders to New Providers
  1. ;
  1. ; This RPC allows the Transferring from one Provider to another
  1. ; which will create an entry into each order in a List into
  1. ; the ORDER TRANSFERS multiple
  1. ;
  1. ; Input:
  1. ; LST(1..n) where each entry contains:
  1. ; ORIEN identifies the IEN of the Order to create a
  1. ; Reassignment (Transfer) for
  1. ; ORPRIEN1 identifies the Transferring From Provider
  1. ; ORPRIEN2 identifies the Transferring To Provider
  1. ; ORUSER identifies the User requesting the Transfer
  1. ; ORDTTM identifies the Transfer Date/Time
  1. ; "C" or "O" indicating whether or not the current pending transfer
  1. ; should be 'Canceled' or 'Overridden'
  1. ; Output:
  1. ; Global ^TMP("ORORDRTN",$J,n) where n represents each record
  1. ; starting with record "1"
  1. ; Contains data for Order IEN ^ Success Flag
  1. ; ^ Error Message if Unsuccessful
  1. ; Where Success Flag = 0 if Unsuccessful or 1 if Successful
  1. ;
  1. N CNT,DA,DIC,DIE,DR,ORDTTM,ORIEN,ORPRIEN1,ORPRIEN2,ORUSER,X,Y,ORTED,DIK,%H
  1. S:'$D(U) U="^" K ^TMP("ORORDRTN",$J)
  1. S RESULTS=$NA(^TMP("ORORDRTN",$J))
  1. S CNT=0 F S CNT=$O(LST(CNT)) Q:CNT="" D
  1. . S ORIEN=$P(LST(CNT),U,1),ORPRIEN1=$P(LST(CNT),U,2)
  1. . S ORPRIEN2=$P(LST(CNT),U,3),ORUSER=$P(LST(CNT),U,4)
  1. . S ORDTTM=$P(LST(CNT),U,5)
  1. . I ORIEN']"" S ^TMP("ORORDRTN",$J,CNT)=ORIEN_U_0_U_"Order IEN Blank" Q
  1. . I '$D(^OR(100,ORIEN)) D Q
  1. .. S ^TMP("ORORDRTN",$J,CNT)=ORIEN_U_0_U_"Invalid Order IEN"
  1. . I ORPRIEN1']"" D Q
  1. .. S ^TMP("ORORDRTN",$J,CNT)=ORIEN_U_0_U_"From Provider IEN Blank"
  1. . I '$D(^VA(200,ORPRIEN1)) D Q
  1. .. S ^TMP("ORORDRTN",$J,CNT)=ORIEN_U_0_U_"From Provider IEN "_ORPRIEN1_" Invalid"
  1. . I ORPRIEN2']"" D Q
  1. .. S ^TMP("ORORDRTN",$J,CNT)=ORIEN_U_0_U_"To Provider IEN Blank"
  1. . I '$D(^VA(200,ORPRIEN2)) D Q
  1. .. S ^TMP("ORORDRTN",$J,CNT)=ORIEN_U_0_U_"To Provider IEN "_ORPRIEN2_" Invalid"
  1. . I ORUSER']"" D Q
  1. .. S ^TMP("ORORDRTN",$J,CNT)=ORIEN_U_0_U_"Transferring User IEN Blank"
  1. . I '$D(^VA(200,ORUSER)) D Q
  1. .. S ^TMP("ORORDRTN",$J,CNT)=ORIEN_U_0_U_"Transferring User IEN "_ORUSER_" Invalid"
  1. . I ORDTTM'?7N S ^TMP("ORORDRTN",$J,CNT)=ORIEN_U_0_U_"Invalid Transfer Date" Q
  1. . I ORDTTM<$P($$NOW^XLFDT(),".") D Q
  1. .. S ^TMP("ORORDRTN",$J,CNT)=ORIEN_U_0_U_"Transfer Date Cannot be in the Past"
  1. . L +^OR(100,ORIEN):0 I '$T D Q
  1. .. S ^TMP("ORORDRTN",$J,CNT)=ORIEN_U_0_U_"Another user is editing this Order."
  1. . I $P(LST(CNT),"^",6)="C"!($P(LST(CNT),"^",6)="O") D Q:$P(LST(CNT),"^",6)="C"
  1. .. S DA=$O(^OR(100,ORIEN,11," "),-1),ORPRIEN1=$P($G(^OR(100,ORIEN,11,DA,0)),"^",2)
  1. .. S DIK="^OR(100,"_ORIEN_",11,",DA(1)=ORIEN D ^DIK
  1. . S %H=$H D YX^%DTC S ORTED=$P(Y,"@")_"@"_$E($P(Y,"@",2),1,5)
  1. . S DIC="^OR(100,"_ORIEN_",11,",DA(1)=ORIEN,DIC(0)="L",X=ORDTTM
  1. . S DIC("DR")=".02////"_ORPRIEN1_";.03////"_ORPRIEN2
  1. . S DIC("DR")=DIC("DR")_";.04////"_ORUSER_";.05///"_ORTED
  1. . D FILE^DICN
  1. . L -^OR(100,ORIEN)
  1. . I +Y<0 S ^TMP("ORORDRTN",$J,CNT)=ORIEN_U_0_U_"Save Unsuccessful" Q
  1. . S ^TMP("ORORDRTN",$J,CNT)=ORIEN_U_1
  1. Q
  1. ;
  1. AUTHUSR(ORY) ; Does user have permission to access Provider
  1. ; Utilities (Provider Role Tool)
  1. S ORY=0
  1. I $D(^XUSEC("OR PRT ACCESS",DUZ)) S ORY=1
  1. Q
  1. HISTORY(RESULTS,ORIEN) ; Show transfer history of an order
  1. N ORI,CNT,A,ORFDT
  1. Q:'$G(ORIEN) S ORI=0,CNT=0 K RESULTS
  1. F S ORI=$O(^OR(100,ORIEN,11,ORI)) Q:'ORI D
  1. . S CNT=CNT+1,A=$G(^OR(100,ORIEN,11,ORI,0))
  1. . S ORFDT=$$FMTE^XLFDT($P(A,"^"))
  1. . S RESULTS(CNT)=ORFDT_"^"_$$GET1^DIQ(200,$P(A,"^",2)_",",.01)_"^"_$$GET1^DIQ(200,$P(A,"^",3)_",",.01)
  1. Q
  1. SAVEALL(OK,LST) ; save the list of sizing information
  1. N I,NAM,VAL,ORERR
  1. S (I,OK)="" F S I=$O(LST(I)) Q:'I D
  1. . S NAM=$P(LST(I),U,1),VAL=$P(LST(I),U,2)
  1. . D EN^XPAR(DUZ_";VA(200,","ORPRT BOUNDS",NAM,VAL,.ORERR)
  1. . I ORERR S OK=OK_LST(I)_":"_ORERR_U
  1. Q
  1. LOADALL(LST) ; load all the sizing related parameters
  1. N ORBOUNDS,ORWIDTHS,ORCOLMNS,ILST,I S ILST=0
  1. D GETLST^XPAR(.ORBOUNDS,DUZ_";VA(200,","ORPRT BOUNDS")
  1. S I="" F S I=$O(ORBOUNDS(I)) Q:'I S ILST=ILST+1,LST(ILST)=ORBOUNDS(I)
  1. Q
  1. LIST(Y,ORSTART,OREND,ORTYPE) ;
  1. I $G(ORTYPE)=""!($G(OREND)="")!($G(ORSTART)="") Q
  1. N ORINDEX,ORST,OREN,ORA,ORB,ORCNT,DA,DIC,DIQ,DR,ORNM
  1. S ORCNT=0
  1. K ^TMP("ORRET",$J),^TMP("ORLIST",$J)
  1. S ORINDEX=$S(ORTYPE=1:"EPRTA",ORTYPE=2:"EPRTC",1:"") Q:ORINDEX=""
  1. S ORST=ORSTART-.01,OREN=+OREND_".9999"
  1. F S ORST=$O(^OR(100,ORINDEX,ORST)) Q:'ORST Q:ORST>OREN D
  1. . S ORB=0
  1. . F S ORB=$O(^OR(100,ORINDEX,ORST,ORB)) Q:'ORB D
  1. .. S ^TMP("ORLIST",$J,ORB)=""
  1. S ORB=0 F S ORB=$O(^TMP("ORLIST",$J,ORB)) Q:'ORB D
  1. . I ORTYPE=1 D
  1. .. K ORNM
  1. .. S DIC=200,DR=.01,DA=ORB,DIQ="ORNM",DIQ(0)="E" D EN^DIQ1
  1. .. S ORCNT=ORCNT+1,^TMP("ORRET",$J,ORCNT)=ORB_"^"_ORNM(200,ORB,.01,"E")
  1. . I ORTYPE=2 D
  1. .. S ORCNT=ORCNT+1,^TMP("ORRET",$J,ORCNT)=ORB_"^"_$P($G(^DPT(ORB,0)),"^")
  1. S Y=$NA(^TMP("ORRET",$J)) K ^TMP("ORLIST",$J)
  1. Q
  1. DATA(Y,ORTYPE,ORA,ORSTART,OREND) ;
  1. N DA,DIC,DIQ,DR,I,OR011,ORCNT,OREN,ORI,ORIEN,ORINDEX,ORNM,ORPNM,ORS,ORS1,ORST,ORSTATUS
  1. I $G(ORTYPE)=""!($G(ORA)="")!($G(ORSTART)="")!($G(OREND)="") Q
  1. K ^TMP("ORRET",$J)
  1. S ORINDEX=$S(ORTYPE=1:"EPRTB",ORTYPE=2:"EPRTD",1:"") Q:ORINDEX=""
  1. I ORTYPE=2 S ORPNM=$P($G(^DPT(ORA,0)),"^")
  1. S ORST=ORSTART-.01,OREN=+OREND_".9999",ORCNT=0
  1. F S ORST=$O(^OR(100,ORINDEX,ORA,ORST)) Q:'ORST Q:ORST>OREN D
  1. . S ORIEN=""
  1. . F S ORIEN=$O(^OR(100,ORINDEX,ORA,ORST,ORIEN)) Q:'ORIEN D
  1. .. I ORTYPE=1 S ORPNM="" S ORI=$P($G(^OR(100,ORIEN,0)),"^",2) I ORI["DPT" S ORPNM=$P($G(^DPT(+ORI,0)),"^")
  1. .. S ORS=$P($G(^OR(100,ORIEN,3)),"^",3),ORSTATUS="" I ORS]"" S ORSTATUS=$P($G(^ORD(100.01,ORS,0)),"^")
  1. .. S ORS1=0
  1. .. F S ORS1=$O(^OR(100,ORIEN,11,ORS1)) Q:'ORS1 D
  1. ... K DA,DR,DIC,ORNM
  1. ... S OR011=$G(^OR(100,ORIEN,11,ORS1,0))
  1. ... F ORI=2:1:4 S DIC=200,DR=.01,DA=$P(OR011,"^",ORI),DIQ="ORNM",DIQ(0)="E" D EN^DIQ1
  1. ... S ORCNT=ORCNT+1,^TMP("ORRET",$J,ORCNT)=ORPNM_"^"_ORIEN_"^"_ORST_"^"_ORSTATUS_"^"_$P(OR011,"^")_"^"
  1. ... F I=2:1:4 S ^TMP("ORRET",$J,ORCNT)=^TMP("ORRET",$J,ORCNT)_ORNM(200,$P(OR011,"^",I),.01,"E")_"^"
  1. ... S ^TMP("ORRET",$J,ORCNT)=^TMP("ORRET",$J,ORCNT)_$P(OR011,"^",5)
  1. S Y=$NA(^TMP("ORRET",$J))
  1. Q
  1. AUDIT(Y,ORAUST,ORAUEN) ;
  1. N DA,DIC,DIQ,DR,I,OR011,ORCNT,ORDFN,OREN,ORI,ORIEN,ORMORE,ORNM,ORPNM,ORS,ORS1,ORST,ORSTATUS,OROD
  1. I $G(ORAUST)=""!($G(ORAUEN)="") Q
  1. K ^TMP("ORRET",$J)
  1. S ORST=ORAUST-.01,OREN=+ORAUEN_".9999",ORCNT=0
  1. F S ORST=$O(^OR(100,"EPRTAU",ORST)) Q:'ORST Q:ORST>OREN D
  1. . S ORIEN=""
  1. . F S ORIEN=$O(^OR(100,"EPRTAU",ORST,ORIEN)) Q:'ORIEN D
  1. .. S ORPNM="" S ORDFN=$P($G(^OR(100,ORIEN,0)),"^",2) I ORDFN["DPT" S ORPNM=$P($G(^DPT(+ORDFN,0)),"^")
  1. .. S ORS=$P($G(^OR(100,ORIEN,3)),"^",3),ORSTATUS="" I ORS]"" S ORSTATUS=$P($G(^ORD(100.01,ORS,0)),"^")
  1. .. S OROD=$P($G(^OR(100,ORIEN,0)),"^",7)
  1. .. S ORS1=0
  1. .. F S ORS1=$O(^OR(100,"EPRTAU",ORST,ORIEN,ORS1)) Q:'ORS1 D
  1. ... K DA,DR,DIC,ORNM
  1. ... S OR011=$G(^OR(100,ORIEN,11,ORS1,0))
  1. ... F ORI=2:1:4 S DIC=200,DR=.01,DA=$P(OR011,"^",ORI),DIQ="ORNM",DIQ(0)="E" D EN^DIQ1
  1. ... S ORMORE=$S($O(^OR(100,ORIEN,11,ORS1)):1,1:0)
  1. ... S ORCNT=ORCNT+1,^TMP("ORRET",$J,ORCNT)=ORPNM_";"_+ORDFN_"^"_ORIEN_"^"_OROD_"^"_ORSTATUS_"^"_$P(OR011,"^")_"^"
  1. ... F I=2:1:4 S ^TMP("ORRET",$J,ORCNT)=^TMP("ORRET",$J,ORCNT)_$G(ORNM(200,$P(OR011,"^",I),.01,"E"))_"^"
  1. ... S ^TMP("ORRET",$J,ORCNT)=^TMP("ORRET",$J,ORCNT)_$P(OR011,"^",5)_"^"_ORMORE
  1. S Y=$NA(^TMP("ORRET",$J))
  1. Q