ORY350B ;SLCOIFO - PRE- AND POST-INSTALL B FOR PATCH OR*3.0*350 ;04/16/15 07:44
;;3.0;ORDER ENTRY/RESULTS REPORTING;**350**;Dec 17, 1997;Build 77
;
PRE ;Pre-Init Entry Point
D PEOMRPT
D EDITEAD
D CONSULT
Q
POST ;Post-Init Entry Point
D PAR
D CONSPAR
Q
PEOMRPT ;Remove new & changed reports from OE/RR REPORTS file (101.24)
N ORI,DA,DIK
S ORI=999
F S ORI=$O(^ORD(101.24,ORI)) Q:'ORI I ORI<1110!(ORI>1116) S DA=ORI,DIK="^ORD(101.24," D ^DIK
Q
PAR ; Parameter Value Transport
D DEL,PUT
K ^TMP($J,"XPARRSTR")
N ENT,IDX,ROOT,REF,VAL,I
S ROOT=$NAME(^TMP($J,"XPARRSTR")),ROOT=$E(ROOT,1,$L(ROOT)-1)_","
D LOAD
S IDX=0,ENT="PKG.ORDER ENTRY/RESULTS REPORTING"
F S IDX=$O(^TMP($J,"XPARRSTR",IDX)) Q:'IDX D
. N PAR,INST,ORVAL,ORERR
. S PAR=$P(^TMP($J,"XPARRSTR",IDX,"KEY"),U),INST=$P(^("KEY"),U,2)
. M ORVAL=^TMP($J,"XPARRSTR",IDX,"VAL")
. D EN^XPAR(ENT,PAR,INST,.ORVAL,.ORERR)
K ^TMP($J,"XPARRSTR")
Q
LOAD ; load data into ^TMP (expects ROOT to be defined)
S I=1 F S REF=$T(DATA+I) Q:REF="" S VAL=$T(DATA+I+1) D
. S I=I+2,REF=$P(REF,";",3,999),VAL=$P(VAL,";",3,999)
. S @(ROOT_REF)=VAL
Q
DEL ;Delete package level parameters
N P
S P="ORWRP REPORT LAB LIST"
D SET("@",P,5)
D SET("@",P,10)
D SET("@",P,15)
D SET("@",P,20)
D SET("@",P,25)
D SET("@",P,30)
D SET("@",P,35)
D SET("@",P,40)
D SET("@",P,45)
D SET("@",P,50)
D SET("@",P,55)
D SET("@",P,60)
D SET("@",P,65)
Q
PUT ;Setup package level parameters
N P
S P="ORWRP REPORT LAB LIST"
D SET("ORRPL LAB OVERVIEW",P,10)
D SET("ORRPL LAB ORDERS PEND",P,15)
D SET("ORL MOST RECENT",P,20)
D SET("ORL WORKSHEET",P,25)
D SET("ORL GRAPH",P,30)
D SET("ORL ALL TESTS BY DATE",P,35)
D SET("ORL SELECTED TESTS BY DATE",P,40)
D SET("ORL MICROBIOLOGY",P,45)
D SET("ORL ANATOMIC PATHOLOGY",P,50)
D SET("ORL BLOOD BANK",P,55)
D SET("ORRPL LAB ORDERS ALL",P,60)
D SET("ORL CUMULATIVE",P,65)
Q
SET(ONAME,P,S) ;Set the parameter
;ONAME=Report name
;P=Parameter name
;S=Sequence (count)
N ORERR
D EN^XPAR("PKG.ORDER ENTRY/RESULTS REPORTING",P,S,ONAME,.ORERR)
Q
EDITEAD ;edit OR GTX EARLIEST DATE to OR GTX CLINICALLY INDICATED DATE
D BMES^XPDUTL("Converting ORDER DIALOG OR GTX EARLIEST DATE to OR GTX CLINICALLY INDICATED DATE")
N DIE,DA,DR,ORNAME,ORDISTXT,ORID
S ORNAME="OR GTX CLINICALLY INDICATED DATE",ORDISTXT="Clinically indicated date:",ORID="CLINICALLY"
Q:+$O(^ORD(101.41,"B",ORNAME,""))'=0
S DIE="^ORD(101.41,"
S DA=$O(^ORD(101.41,"B","OR GTX EARLIEST DATE",""))
I +$G(DA)'>0 D S XPDABORT=1 Q
.D BMES^XPDUTL("Cannot find OR GTX EARLIEST DATE in file 101.41")
.D MES^XPDUTL("No changes have been made. Install will abort.")
.D MES^XPDUTL("Please submit a Remedy ticket for assistance.")
I $G(XPDABORT)=1 Q
S DR=".01///^S X=ORNAME;2///^S X=ORDISTXT;13///^S X=ORID"
D ^DIE
L +^FILE(101.41,DA):0 I $T D ^DIE L -^FILE(101.41,DA) D MES^XPDUTL("Conversion Complete") Q
D MES^XPDUTL("Unable to lock OR GTX EARLIEST DATE for edit. No changes made.")
S XPDABORT=1 D MES^XPDUTL("Install will abort. Please try again.")
Q
LU(FILE,NAME,FLAGS,SCREEN,INDEXES) ; call FileMan Finder to look up file entry
Q $$FIND1^DIC(FILE,"",$G(FLAGS),NAME,$G(INDEXES),$G(SCREEN),"MSGERR")
CONSPAR ; set any value found for EAD at PKG level back into the CID at SYS level.
D BMES^XPDUTL("The System level value for ORCDGMRC CLIN IND DATE DEFAULT will now")
D MES^XPDUTL("be set to the Package level value for ORCDGMRC EARLIEST DATE DEFAULT.")
D MES^XPDUTL("When that is complete, the ORCDGMRC EARLIEST DATE DEFAULT parameter")
D MES^XPDUTL("will be removed from the system.")
N ORPARVAL,ORERR,ORPAREAD,ORPARCID,OREADIEN,ORCIDIEN,ORMSG
S ORPAREAD="ORCDGMRC EARLIEST DATE DEFAULT",ORPARCID="ORCDGMRC CLIN IND DATE DEFAULT"
S OREADIEN=$$LU(8989.51,ORPAREAD,"X")
S ORCIDIEN=$$LU(8989.51,ORPARCID,"X")
I +$G(OREADIEN)'>0 D BMES^XPDUTL("Unable to find "_ORPAREAD_". No value set.") Q
I +$G(ORCIDIEN)'>0 D BMES^XPDUTL("Unable to find "_ORPARCID_". No value set.") Q
S ORPARVAL=$$GET^XPAR("PKG",ORPAREAD,1,"I")
I $L($G(ORPARVAL))>0 D EN^XPAR("SYS",ORPARCID,1,ORPARVAL,.ORERR)
I +$G(ORERR)'=0 D Q
.D BMES^XPDUTL("ERROR OCCURRED SETTING "_ORPARCID)
.D MES^XPDUTL("AT THE SYSTEM LEVEL. THE ERROR IS:")
.D BMES^XPDUTL("ERROR NUMBER: "_+$G(ORERR))
.D MES^XPDUTL("ERROR TEXT: "_$P($G(ORERR),U,2))
E D
.S:ORPARVAL="" ORMSG="NULL"
.D BMES^XPDUTL(ORPARCID_" has been set to "_ORPARVAL)
.D DELPARM
Q
;
DELPARM ;remove ORCDGMRC EARLIEST DATE DEFAULT from the system
N ORLIST,ENT,PAR,OERR
;get instances of parameter
S ENT="",PAR="ORCDGMRC EARLIEST DATE DEFAULT"
D ENVAL^XPAR(.ORLIST,PAR,1,.OERR)
;delete instances
D BMES^XPDUTL("Attempting to remove values for parameter ORCDGMRC EARLIEST DATE DEFAULT...")
F S ENT=$O(ORLIST(ENT)) Q:ENT="" D DEL^XPAR(ENT,PAR,1,.OERR) I $G(OERR)>0 W !,OERR
D:+$G(OERR)=0 MES^XPDUTL("Values have been removed")
;delete parameter
N DA,DIK
S DIK="^XTV(8989.51,"
S DA=$O(^XTV(8989.51,"B",PAR,"")) Q:+$G(DA)'>0 D BMES^XPDUTL("Attempting to delete parameter ORCDGMRC EARLIEST DATE DEFAULT from PARAMETER DEFINITION file")
D ^DIK D:+$G(DA)>0 MES^XPDUTL("Delete successful")
Q
CONSULT ;
K ^TMP("OR350_EADID",$J)
N ZTIO,ZTRTN,ZTDESC,ZTSAVE,ZTSK,ORCONREC
S ORCONREC=$G(DUZ),ZTSAVE("ORCONREC")=""
S ZTIO="",ZTRTN="START^ORY350B",ZTDESC="Find Consult Orders and Edit ID Field"
D ^%ZTLOAD
I +$G(ZTSK)>0 D BMES^XPDUTL("TASK "_$G(ZTSK)_" HAS BEEN QUEUED.")
I +$G(ZTSK)=0 D BMES^XPDUTL("Unable to queue the """_ZTDESC_""" task; file a Remedy ticket for assistance.")
Q
;
START ;start search for consult orders
D FINDORD
D SENDMAIL
Q
;
FINDORD ;find cons/proc orders and change OR GTX EARLIEST DATE item ID value from EARLIEST to CLINICALLY
N ORCOUNT S ORCOUNT=1
S ^TMP("OR350_EADID",$J,ORCOUNT)="This message contains a list of ORDER file (#100) IENs where the ID field",ORCOUNT=ORCOUNT+1
S ^TMP("OR350_EADID",$J,ORCOUNT)="was edited from EARLIEST to CLINICALLY for the OR GTX EARLIEST DATE Item Entry.",ORCOUNT=ORCOUNT+1
S ^TMP("OR350_EADID",$J,ORCOUNT)="Any unsuccessful edits are also captured and noted as such.",ORCOUNT=ORCOUNT+1
S ^TMP("OR350_EADID",$J,ORCOUNT)="For those orders, you may manually edit the ID field for the ",ORCOUNT=ORCOUNT+1
S ^TMP("OR350_EADID",$J,ORCOUNT)="OR GTX CLINICALLY INDICATED DATE Item Entry",ORCOUNT=ORCOUNT+1
S ^TMP("OR350_EADID",$J,ORCOUNT)="Change the value from EARLIEST to CLINICALLY.",ORCOUNT=ORCOUNT+1
S ^TMP("OR350_EADID",$J,ORCOUNT)="Submit a Remedy ticket if you need/prefer assistance with these edits.",ORCOUNT=ORCOUNT+1
S ^TMP("OR350_EADID",$J,ORCOUNT)="",ORCOUNT=ORCOUNT+1
N ORCON,ORPROC,ORIFN,ORDISGRP
S ORCON=$O(^ORD(100.98,"B","CONSULTS","")) Q:+$G(ORCON)'>0
S ORPROC=$O(^ORD(100.98,"B","PROCEDURES","")) Q:+$G(ORPROC)'>0
N ORDATE S ORDATE=3080701 ;start search before EARLIEST DATE was live (8/4/2010 first prod install)
N ORIDX S ORIDX=$Q(^OR(100,"AF",ORDATE))
F S ORIDX=$Q(@ORIDX) Q:ORIDX'?1"^OR(100,""AF"",".E D
.S ORIFN=$P(ORIDX,",",4) Q:+$G(ORIFN)'>0
.Q:$D(^OR(100,ORIFN,0))=0
.S ORDISGRP=$P(^OR(100,ORIFN,0),U,11) Q:+$G(ORDISGRP)'>0
.Q:(+$G(ORDISGRP)'=ORCON)&(+$G(ORDISGRP)'=ORPROC)
.D UPDATEID(ORIFN)
I ORCOUNT'>9 D
.S ^TMP("OR350_EADID",$J,ORCOUNT)="No orders found to edit. If this is the first time this report has been run,",ORCOUNT=ORCOUNT+1
.S ^TMP("OR350_EADID",$J,ORCOUNT)="please submit a Remedy ticket for assistance.",ORCOUNT=ORCOUNT+1
Q
;
UPDATEID(ORDA) ;update ID value for order. Change "EARLIEST" to "CLINICALLY"
Q:+$G(ORDA)'>0
N DIE,DA,DR,ORITEM S ORITEM=0
S DR=".04///CLINICALLY"
F S ORITEM=$O(^OR(100,ORDA,4.5,ORITEM)) Q:+$G(ORITEM)'>0 D
.Q:$P(^OR(100,ORDA,4.5,ORITEM,0),U,4)'="EARLIEST"
.S DIE="^OR(100,"_ORDA_",4.5,",DA(1)=ORDA,DA=ORITEM
.L +^FILE(100,ORDA):0 I $T D ^DIE L -^FILE(100,ORDA) S ^TMP("OR350_EADID",$J,ORCOUNT)=ORDA,ORCOUNT=ORCOUNT+1 Q
.S ^TMP("OR350_EADID",$J,ORCOUNT)=ORDA_"^Could not lock file entry for edit",ORCOUNT=ORCOUNT+1
Q
;
SENDMAIL ;send message with list of edited orders
N XMSUB,XMTEXT,XMY,XMZ,XMDUZ,XMMG,DIFROM
S XMSUB="CONSULT ORDERS: ID FIELD EDIT"
S:$G(DUZ) XMY(DUZ)=""
S XMDUZ="OR*3.0*350 INSTALL"
S XMTEXT="^TMP(""OR350_EADID"",$J,"
D ^XMD
Q
;
DATA ; parameter data
;;9345,"KEY")
;;OR LAB TAB DEFAULT REPORT^1
;;9345,"VAL")
;;ORL MOST RECENT
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HORY350B 8456 printed Dec 13, 2024@02:41:28 Page 2
ORY350B ;SLCOIFO - PRE- AND POST-INSTALL B FOR PATCH OR*3.0*350 ;04/16/15 07:44
+1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**350**;Dec 17, 1997;Build 77
+2 ;
PRE ;Pre-Init Entry Point
+1 DO PEOMRPT
+2 DO EDITEAD
+3 DO CONSULT
+4 QUIT
POST ;Post-Init Entry Point
+1 DO PAR
+2 DO CONSPAR
+3 QUIT
PEOMRPT ;Remove new & changed reports from OE/RR REPORTS file (101.24)
+1 NEW ORI,DA,DIK
+2 SET ORI=999
+3 FOR
SET ORI=$ORDER(^ORD(101.24,ORI))
if 'ORI
QUIT
IF ORI<1110!(ORI>1116)
SET DA=ORI
SET DIK="^ORD(101.24,"
DO ^DIK
+4 QUIT
PAR ; Parameter Value Transport
+1 DO DEL
DO PUT
+2 KILL ^TMP($JOB,"XPARRSTR")
+3 NEW ENT,IDX,ROOT,REF,VAL,I
+4 SET ROOT=$NAME(^TMP($JOB,"XPARRSTR"))
SET ROOT=$EXTRACT(ROOT,1,$LENGTH(ROOT)-1)_","
+5 DO LOAD
+6 SET IDX=0
SET ENT="PKG.ORDER ENTRY/RESULTS REPORTING"
+7 FOR
SET IDX=$ORDER(^TMP($JOB,"XPARRSTR",IDX))
if 'IDX
QUIT
Begin DoDot:1
+8 NEW PAR,INST,ORVAL,ORERR
+9 SET PAR=$PIECE(^TMP($JOB,"XPARRSTR",IDX,"KEY"),U)
SET INST=$PIECE(^("KEY"),U,2)
+10 MERGE ORVAL=^TMP($JOB,"XPARRSTR",IDX,"VAL")
+11 DO EN^XPAR(ENT,PAR,INST,.ORVAL,.ORERR)
End DoDot:1
+12 KILL ^TMP($JOB,"XPARRSTR")
+13 QUIT
LOAD ; load data into ^TMP (expects ROOT to be defined)
+1 SET I=1
FOR
SET REF=$TEXT(DATA+I)
if REF=""
QUIT
SET VAL=$TEXT(DATA+I+1)
Begin DoDot:1
+2 SET I=I+2
SET REF=$PIECE(REF,";",3,999)
SET VAL=$PIECE(VAL,";",3,999)
+3 SET @(ROOT_REF)=VAL
End DoDot:1
+4 QUIT
DEL ;Delete package level parameters
+1 NEW P
+2 SET P="ORWRP REPORT LAB LIST"
+3 DO SET("@",P,5)
+4 DO SET("@",P,10)
+5 DO SET("@",P,15)
+6 DO SET("@",P,20)
+7 DO SET("@",P,25)
+8 DO SET("@",P,30)
+9 DO SET("@",P,35)
+10 DO SET("@",P,40)
+11 DO SET("@",P,45)
+12 DO SET("@",P,50)
+13 DO SET("@",P,55)
+14 DO SET("@",P,60)
+15 DO SET("@",P,65)
+16 QUIT
PUT ;Setup package level parameters
+1 NEW P
+2 SET P="ORWRP REPORT LAB LIST"
+3 DO SET("ORRPL LAB OVERVIEW",P,10)
+4 DO SET("ORRPL LAB ORDERS PEND",P,15)
+5 DO SET("ORL MOST RECENT",P,20)
+6 DO SET("ORL WORKSHEET",P,25)
+7 DO SET("ORL GRAPH",P,30)
+8 DO SET("ORL ALL TESTS BY DATE",P,35)
+9 DO SET("ORL SELECTED TESTS BY DATE",P,40)
+10 DO SET("ORL MICROBIOLOGY",P,45)
+11 DO SET("ORL ANATOMIC PATHOLOGY",P,50)
+12 DO SET("ORL BLOOD BANK",P,55)
+13 DO SET("ORRPL LAB ORDERS ALL",P,60)
+14 DO SET("ORL CUMULATIVE",P,65)
+15 QUIT
SET(ONAME,P,S) ;Set the parameter
+1 ;ONAME=Report name
+2 ;P=Parameter name
+3 ;S=Sequence (count)
+4 NEW ORERR
+5 DO EN^XPAR("PKG.ORDER ENTRY/RESULTS REPORTING",P,S,ONAME,.ORERR)
+6 QUIT
EDITEAD ;edit OR GTX EARLIEST DATE to OR GTX CLINICALLY INDICATED DATE
+1 DO BMES^XPDUTL("Converting ORDER DIALOG OR GTX EARLIEST DATE to OR GTX CLINICALLY INDICATED DATE")
+2 NEW DIE,DA,DR,ORNAME,ORDISTXT,ORID
+3 SET ORNAME="OR GTX CLINICALLY INDICATED DATE"
SET ORDISTXT="Clinically indicated date:"
SET ORID="CLINICALLY"
+4 if +$ORDER(^ORD(101.41,"B",ORNAME,""))'=0
QUIT
+5 SET DIE="^ORD(101.41,"
+6 SET DA=$ORDER(^ORD(101.41,"B","OR GTX EARLIEST DATE",""))
+7 IF +$GET(DA)'>0
Begin DoDot:1
+8 DO BMES^XPDUTL("Cannot find OR GTX EARLIEST DATE in file 101.41")
+9 DO MES^XPDUTL("No changes have been made. Install will abort.")
+10 DO MES^XPDUTL("Please submit a Remedy ticket for assistance.")
End DoDot:1
SET XPDABORT=1
QUIT
+11 IF $GET(XPDABORT)=1
QUIT
+12 SET DR=".01///^S X=ORNAME;2///^S X=ORDISTXT;13///^S X=ORID"
+13 DO ^DIE
+14 LOCK +^FILE(101.41,DA):0
IF $TEST
DO ^DIE
LOCK -^FILE(101.41,DA)
DO MES^XPDUTL("Conversion Complete")
QUIT
+15 DO MES^XPDUTL("Unable to lock OR GTX EARLIEST DATE for edit. No changes made.")
+16 SET XPDABORT=1
DO MES^XPDUTL("Install will abort. Please try again.")
+17 QUIT
LU(FILE,NAME,FLAGS,SCREEN,INDEXES) ; call FileMan Finder to look up file entry
+1 QUIT $$FIND1^DIC(FILE,"",$GET(FLAGS),NAME,$GET(INDEXES),$GET(SCREEN),"MSGERR")
CONSPAR ; set any value found for EAD at PKG level back into the CID at SYS level.
+1 DO BMES^XPDUTL("The System level value for ORCDGMRC CLIN IND DATE DEFAULT will now")
+2 DO MES^XPDUTL("be set to the Package level value for ORCDGMRC EARLIEST DATE DEFAULT.")
+3 DO MES^XPDUTL("When that is complete, the ORCDGMRC EARLIEST DATE DEFAULT parameter")
+4 DO MES^XPDUTL("will be removed from the system.")
+5 NEW ORPARVAL,ORERR,ORPAREAD,ORPARCID,OREADIEN,ORCIDIEN,ORMSG
+6 SET ORPAREAD="ORCDGMRC EARLIEST DATE DEFAULT"
SET ORPARCID="ORCDGMRC CLIN IND DATE DEFAULT"
+7 SET OREADIEN=$$LU(8989.51,ORPAREAD,"X")
+8 SET ORCIDIEN=$$LU(8989.51,ORPARCID,"X")
+9 IF +$GET(OREADIEN)'>0
DO BMES^XPDUTL("Unable to find "_ORPAREAD_". No value set.")
QUIT
+10 IF +$GET(ORCIDIEN)'>0
DO BMES^XPDUTL("Unable to find "_ORPARCID_". No value set.")
QUIT
+11 SET ORPARVAL=$$GET^XPAR("PKG",ORPAREAD,1,"I")
+12 IF $LENGTH($GET(ORPARVAL))>0
DO EN^XPAR("SYS",ORPARCID,1,ORPARVAL,.ORERR)
+13 IF +$GET(ORERR)'=0
Begin DoDot:1
+14 DO BMES^XPDUTL("ERROR OCCURRED SETTING "_ORPARCID)
+15 DO MES^XPDUTL("AT THE SYSTEM LEVEL. THE ERROR IS:")
+16 DO BMES^XPDUTL("ERROR NUMBER: "_+$GET(ORERR))
+17 DO MES^XPDUTL("ERROR TEXT: "_$PIECE($GET(ORERR),U,2))
End DoDot:1
QUIT
+18 IF '$TEST
Begin DoDot:1
+19 if ORPARVAL=""
SET ORMSG="NULL"
+20 DO BMES^XPDUTL(ORPARCID_" has been set to "_ORPARVAL)
+21 DO DELPARM
End DoDot:1
+22 QUIT
+23 ;
DELPARM ;remove ORCDGMRC EARLIEST DATE DEFAULT from the system
+1 NEW ORLIST,ENT,PAR,OERR
+2 ;get instances of parameter
+3 SET ENT=""
SET PAR="ORCDGMRC EARLIEST DATE DEFAULT"
+4 DO ENVAL^XPAR(.ORLIST,PAR,1,.OERR)
+5 ;delete instances
+6 DO BMES^XPDUTL("Attempting to remove values for parameter ORCDGMRC EARLIEST DATE DEFAULT...")
+7 FOR
SET ENT=$ORDER(ORLIST(ENT))
if ENT=""
QUIT
DO DEL^XPAR(ENT,PAR,1,.OERR)
IF $GET(OERR)>0
WRITE !,OERR
+8 if +$GET(OERR)=0
DO MES^XPDUTL("Values have been removed")
+9 ;delete parameter
+10 NEW DA,DIK
+11 SET DIK="^XTV(8989.51,"
+12 SET DA=$ORDER(^XTV(8989.51,"B",PAR,""))
if +$GET(DA)'>0
QUIT
DO BMES^XPDUTL("Attempting to delete parameter ORCDGMRC EARLIEST DATE DEFAULT from PARAMETER DEFINITION file")
+13 DO ^DIK
if +$GET(DA)>0
DO MES^XPDUTL("Delete successful")
+14 QUIT
CONSULT ;
+1 KILL ^TMP("OR350_EADID",$JOB)
+2 NEW ZTIO,ZTRTN,ZTDESC,ZTSAVE,ZTSK,ORCONREC
+3 SET ORCONREC=$GET(DUZ)
SET ZTSAVE("ORCONREC")=""
+4 SET ZTIO=""
SET ZTRTN="START^ORY350B"
SET ZTDESC="Find Consult Orders and Edit ID Field"
+5 DO ^%ZTLOAD
+6 IF +$GET(ZTSK)>0
DO BMES^XPDUTL("TASK "_$GET(ZTSK)_" HAS BEEN QUEUED.")
+7 IF +$GET(ZTSK)=0
DO BMES^XPDUTL("Unable to queue the """_ZTDESC_""" task; file a Remedy ticket for assistance.")
+8 QUIT
+9 ;
START ;start search for consult orders
+1 DO FINDORD
+2 DO SENDMAIL
+3 QUIT
+4 ;
FINDORD ;find cons/proc orders and change OR GTX EARLIEST DATE item ID value from EARLIEST to CLINICALLY
+1 NEW ORCOUNT
SET ORCOUNT=1
+2 SET ^TMP("OR350_EADID",$JOB,ORCOUNT)="This message contains a list of ORDER file (#100) IENs where the ID field"
SET ORCOUNT=ORCOUNT+1
+3 SET ^TMP("OR350_EADID",$JOB,ORCOUNT)="was edited from EARLIEST to CLINICALLY for the OR GTX EARLIEST DATE Item Entry."
SET ORCOUNT=ORCOUNT+1
+4 SET ^TMP("OR350_EADID",$JOB,ORCOUNT)="Any unsuccessful edits are also captured and noted as such."
SET ORCOUNT=ORCOUNT+1
+5 SET ^TMP("OR350_EADID",$JOB,ORCOUNT)="For those orders, you may manually edit the ID field for the "
SET ORCOUNT=ORCOUNT+1
+6 SET ^TMP("OR350_EADID",$JOB,ORCOUNT)="OR GTX CLINICALLY INDICATED DATE Item Entry"
SET ORCOUNT=ORCOUNT+1
+7 SET ^TMP("OR350_EADID",$JOB,ORCOUNT)="Change the value from EARLIEST to CLINICALLY."
SET ORCOUNT=ORCOUNT+1
+8 SET ^TMP("OR350_EADID",$JOB,ORCOUNT)="Submit a Remedy ticket if you need/prefer assistance with these edits."
SET ORCOUNT=ORCOUNT+1
+9 SET ^TMP("OR350_EADID",$JOB,ORCOUNT)=""
SET ORCOUNT=ORCOUNT+1
+10 NEW ORCON,ORPROC,ORIFN,ORDISGRP
+11 SET ORCON=$ORDER(^ORD(100.98,"B","CONSULTS",""))
if +$GET(ORCON)'>0
QUIT
+12 SET ORPROC=$ORDER(^ORD(100.98,"B","PROCEDURES",""))
if +$GET(ORPROC)'>0
QUIT
+13 ;start search before EARLIEST DATE was live (8/4/2010 first prod install)
NEW ORDATE
SET ORDATE=3080701
+14 NEW ORIDX
SET ORIDX=$QUERY(^OR(100,"AF",ORDATE))
+15 FOR
SET ORIDX=$QUERY(@ORIDX)
if ORIDX'?1"^OR(100,""AF"",".E
QUIT
Begin DoDot:1
+16 SET ORIFN=$PIECE(ORIDX,",",4)
if +$GET(ORIFN)'>0
QUIT
+17 if $DATA(^OR(100,ORIFN,0))=0
QUIT
+18 SET ORDISGRP=$PIECE(^OR(100,ORIFN,0),U,11)
if +$GET(ORDISGRP)'>0
QUIT
+19 if (+$GET(ORDISGRP)'=ORCON)&(+$GET(ORDISGRP)'=ORPROC)
QUIT
+20 DO UPDATEID(ORIFN)
End DoDot:1
+21 IF ORCOUNT'>9
Begin DoDot:1
+22 SET ^TMP("OR350_EADID",$JOB,ORCOUNT)="No orders found to edit. If this is the first time this report has been run,"
SET ORCOUNT=ORCOUNT+1
+23 SET ^TMP("OR350_EADID",$JOB,ORCOUNT)="please submit a Remedy ticket for assistance."
SET ORCOUNT=ORCOUNT+1
End DoDot:1
+24 QUIT
+25 ;
UPDATEID(ORDA) ;update ID value for order. Change "EARLIEST" to "CLINICALLY"
+1 if +$GET(ORDA)'>0
QUIT
+2 NEW DIE,DA,DR,ORITEM
SET ORITEM=0
+3 SET DR=".04///CLINICALLY"
+4 FOR
SET ORITEM=$ORDER(^OR(100,ORDA,4.5,ORITEM))
if +$GET(ORITEM)'>0
QUIT
Begin DoDot:1
+5 if $PIECE(^OR(100,ORDA,4.5,ORITEM,0),U,4)'="EARLIEST"
QUIT
+6 SET DIE="^OR(100,"_ORDA_",4.5,"
SET DA(1)=ORDA
SET DA=ORITEM
+7 LOCK +^FILE(100,ORDA):0
IF $TEST
DO ^DIE
LOCK -^FILE(100,ORDA)
SET ^TMP("OR350_EADID",$JOB,ORCOUNT)=ORDA
SET ORCOUNT=ORCOUNT+1
QUIT
+8 SET ^TMP("OR350_EADID",$JOB,ORCOUNT)=ORDA_"^Could not lock file entry for edit"
SET ORCOUNT=ORCOUNT+1
End DoDot:1
+9 QUIT
+10 ;
SENDMAIL ;send message with list of edited orders
+1 NEW XMSUB,XMTEXT,XMY,XMZ,XMDUZ,XMMG,DIFROM
+2 SET XMSUB="CONSULT ORDERS: ID FIELD EDIT"
+3 if $GET(DUZ)
SET XMY(DUZ)=""
+4 SET XMDUZ="OR*3.0*350 INSTALL"
+5 SET XMTEXT="^TMP(""OR350_EADID"",$J,"
+6 DO ^XMD
+7 QUIT
+8 ;
DATA ; parameter data
+1 ;;9345,"KEY")
+2 ;;OR LAB TAB DEFAULT REPORT^1
+3 ;;9345,"VAL")
+4 ;;ORL MOST RECENT
