ORY158 ;SLC/DAN ;11/14/02 08:36
;;3.0;ORDER ENTRY/RESULTS REPORTING;**158**;Dec 17, 1997
;DBIA 2058 allows read of B xref in DIC(9.4
;DBIA 2197 allows reading of install file
;
POST ;Find child entries with a provider of 0 and update it to the correct provider
;
N ORMSG,ZTSK,ZTRTN,ZTDESC,ZTIO,ZTDTH,ZTSAVE
S ORMSG(1)="This patch contains a post-init which will run in the background and fix"
S ORMSG(2)="any known database errors. It will then send a mail message to the"
S ORMSG(3)="initiator indicating what was changed."
D BMES^XPDUTL(.ORMSG)
S ZTRTN="DQ^ORY158",ZTDESC="Patch OR*3*158 database clean up",ZTIO="",ZTSAVE("DUZ")="",ZTDTH=$H
D ^%ZTLOAD
I $G(ZTSK) D BMES^XPDUTL("Post-init queued to background as task number "_ZTSK_".")
Q
;
DQ ;Enter here for queued task
N ERR,CNT
K ^TMP("ORFIX",$J)
D UPDATE,MAIL
K ^TMP("ORFIX",$J)
Q
;
UPDATE ;
N DATE,IEN,PARENT,PROV,PKG,PKGNUM
S DATE=$$INSTDT("ORDER ENTRY/RESULTS REPORTING 3.0")
S DATE=$S(DATE:$$FMADD^XLFDT(DATE,-1,23,59),1:2960630.24) ;If install date not found revert back to 1st possible install date
S IEN=$$GETIEN(DATE)-1 ;Get first order number for date, subtract one so the first order is reviewed
I IEN=-1 S ERR="No orders in date range" Q ;No orders to review
S CNT=0
F S IEN=$O(^OR(100,IEN)) Q:'+IEN D
.Q:+$P(^OR(100,IEN,0),U,4)'=0 ;Quit if order is ok (provider '= 0)
.S PKGNUM=$P(^OR(100,IEN,0),U,14)
.S PKG=$E($$NMSP^ORCD(PKGNUM),1,2) ;Get first two characters of Package
.I PKG="LR"&($P(^OR(100,IEN,0),U,2)'["DPT") Q ;Stop if lab and not from patient file
.I PKG="LR"!(PKG="PS") D Q ;If package lab or pharmacy then check
..S PROV=$$CHKPAR
..I PROV D
...S ^TMP("ORFIX",$J,PKGNUM,IEN)=" - FIXED"
...S $P(^OR(100,IEN,0),U,4)=PROV
...S CNT=CNT+1
...D CHKACT ;Check actions to be sure they have provider entered
Q
;
CHKPAR() ;Check to see if there is a parent order and if so, return provider
S PARENT=$P(^OR(100,IEN,3),U,9)
I '+PARENT Q 0 ;No parent order found
S PROV=$P(^OR(100,PARENT,0),U,4)
I '+PROV Q 0 ;No provider found in parent order
Q PROV
;
CHKACT ;Check actions for missing provider as well
N I
S I=0 F S I=$O(^OR(100,IEN,8,I)) Q:'+I D
.I $P(^OR(100,IEN,8,I,0),U,3)=0 S $P(^(0),U,3)=PROV
Q
GETIEN(STDT) ;Find first IEN associated with given start date
N DONE,IEN
S (DONE,IEN)=0
F S STDT=$O(^OR(100,"AF",STDT)) Q:'+STDT!(DONE) D
.S IEN=0 F S IEN=$O(^OR(100,"AF",STDT,IEN)) Q:'+IEN I $O(^(IEN,0))=1 S DONE=1 Q ;Find first ORDER that is a new order
Q IEN
;
MAIL ;Send results of cleanup in a mail message to initiator
N I,XMSUB,XMTEXT,XMDUZ,XMY,PKG,ORD
S XMSUB="Patch OR*3*158 Clean up completed"
S XMDUZ="Patch OR*3*158 Post-Init"
S XMY(.5)="" S:$G(DUZ) XMY(DUZ)=""
S XMTEXT="^TMP(""ORTXT"",$J,"
K ^TMP("ORTXT",$J)
S I=1
S ^TMP("ORTXT",$J,I)="The database clean-up for patch OR*3*158 has completed.",I=I+1
S ^TMP("ORTXT",$J,I)="Below is a listing of what was changed and any possible error messages.",I=I+1
S ^TMP("ORTXT",$J,I)="",I=I+1
S ^TMP("ORTXT",$J,I)=CNT_" orders had their provider field updated.",I=I+1
S ^TMP("ORTXT",$J,I)="",I=I+1
I $D(ERR) D
.S ^TMP("ORTXT",$J,I)="An error occurred that stopped the post-init. It was:",I=I+1
.S ^TMP("ORTXT",$J,I)=ERR,I=I+1
.S ^TMP("ORTXT",$J,I)="",I=I+1
I '$D(ERR),'CNT S ^TMP("ORTXT",$J,I)="No changes were made to your database.",I=I+1
S ^TMP("ORTXT",$J,I)="",I=I+1
S PKG=0 F S PKG=$O(^TMP("ORFIX",$J,PKG)) Q:PKG="" D
.S ^TMP("ORTXT",$J,I)=$P(^DIC(9.4,PKG,0),U),I=I+1
.S ORD=0 F S ORD=$O(^TMP("ORFIX",$J,PKG,ORD)) Q:ORD="" D
..S ^TMP("ORTXT",$J,I)=" ORDER #: "_ORD_" "_^TMP("ORFIX",$J,PKG,ORD),I=I+1
.S ^TMP("ORTXT",$J,I)="",I=I+1
D ^XMD ;send results
K ^TMP("ORTXT",$J)
Q
;
INSTDT(PATCH) ;Returns installation date patch first installed at site
N IEN
S IEN=$O(^XPD(9.7,"B",PATCH,0)) Q:'+IEN 0 ;Get IEN of first installation
Q $P($P($G(^XPD(9.7,IEN,1)),U),".") ;Get date of first install
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HORY158 4024 printed Dec 13, 2024@02:38:48 Page 2
ORY158 ;SLC/DAN ;11/14/02 08:36
+1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**158**;Dec 17, 1997
+2 ;DBIA 2058 allows read of B xref in DIC(9.4
+3 ;DBIA 2197 allows reading of install file
+4 ;
POST ;Find child entries with a provider of 0 and update it to the correct provider
+1 ;
+2 NEW ORMSG,ZTSK,ZTRTN,ZTDESC,ZTIO,ZTDTH,ZTSAVE
+3 SET ORMSG(1)="This patch contains a post-init which will run in the background and fix"
+4 SET ORMSG(2)="any known database errors. It will then send a mail message to the"
+5 SET ORMSG(3)="initiator indicating what was changed."
+6 DO BMES^XPDUTL(.ORMSG)
+7 SET ZTRTN="DQ^ORY158"
SET ZTDESC="Patch OR*3*158 database clean up"
SET ZTIO=""
SET ZTSAVE("DUZ")=""
SET ZTDTH=$HOROLOG
+8 DO ^%ZTLOAD
+9 IF $GET(ZTSK)
DO BMES^XPDUTL("Post-init queued to background as task number "_ZTSK_".")
+10 QUIT
+11 ;
DQ ;Enter here for queued task
+1 NEW ERR,CNT
+2 KILL ^TMP("ORFIX",$JOB)
+3 DO UPDATE
DO MAIL
+4 KILL ^TMP("ORFIX",$JOB)
+5 QUIT
+6 ;
UPDATE ;
+1 NEW DATE,IEN,PARENT,PROV,PKG,PKGNUM
+2 SET DATE=$$INSTDT("ORDER ENTRY/RESULTS REPORTING 3.0")
+3 ;If install date not found revert back to 1st possible install date
SET DATE=$SELECT(DATE:$$FMADD^XLFDT(DATE,-1,23,59),1:2960630.24)
+4 ;Get first order number for date, subtract one so the first order is reviewed
SET IEN=$$GETIEN(DATE)-1
+5 ;No orders to review
IF IEN=-1
SET ERR="No orders in date range"
QUIT
+6 SET CNT=0
+7 FOR
SET IEN=$ORDER(^OR(100,IEN))
if '+IEN
QUIT
Begin DoDot:1
+8 ;Quit if order is ok (provider '= 0)
if +$PIECE(^OR(100,IEN,0),U,4)'=0
QUIT
+9 SET PKGNUM=$PIECE(^OR(100,IEN,0),U,14)
+10 ;Get first two characters of Package
SET PKG=$EXTRACT($$NMSP^ORCD(PKGNUM),1,2)
+11 ;Stop if lab and not from patient file
IF PKG="LR"&($PIECE(^OR(100,IEN,0),U,2)'["DPT")
QUIT
+12 ;If package lab or pharmacy then check
IF PKG="LR"!(PKG="PS")
Begin DoDot:2
+13 SET PROV=$$CHKPAR
+14 IF PROV
Begin DoDot:3
+15 SET ^TMP("ORFIX",$JOB,PKGNUM,IEN)=" - FIXED"
+16 SET $PIECE(^OR(100,IEN,0),U,4)=PROV
+17 SET CNT=CNT+1
+18 ;Check actions to be sure they have provider entered
DO CHKACT
End DoDot:3
End DoDot:2
QUIT
End DoDot:1
+19 QUIT
+20 ;
CHKPAR() ;Check to see if there is a parent order and if so, return provider
+1 SET PARENT=$PIECE(^OR(100,IEN,3),U,9)
+2 ;No parent order found
IF '+PARENT
QUIT 0
+3 SET PROV=$PIECE(^OR(100,PARENT,0),U,4)
+4 ;No provider found in parent order
IF '+PROV
QUIT 0
+5 QUIT PROV
+6 ;
CHKACT ;Check actions for missing provider as well
+1 NEW I
+2 SET I=0
FOR
SET I=$ORDER(^OR(100,IEN,8,I))
if '+I
QUIT
Begin DoDot:1
+3 IF $PIECE(^OR(100,IEN,8,I,0),U,3)=0
SET $PIECE(^(0),U,3)=PROV
End DoDot:1
+4 QUIT
GETIEN(STDT) ;Find first IEN associated with given start date
+1 NEW DONE,IEN
+2 SET (DONE,IEN)=0
+3 FOR
SET STDT=$ORDER(^OR(100,"AF",STDT))
if '+STDT!(DONE)
QUIT
Begin DoDot:1
+4 ;Find first ORDER that is a new order
SET IEN=0
FOR
SET IEN=$ORDER(^OR(100,"AF",STDT,IEN))
if '+IEN
QUIT
IF $ORDER(^(IEN,0))=1
SET DONE=1
QUIT
End DoDot:1
+5 QUIT IEN
+6 ;
MAIL ;Send results of cleanup in a mail message to initiator
+1 NEW I,XMSUB,XMTEXT,XMDUZ,XMY,PKG,ORD
+2 SET XMSUB="Patch OR*3*158 Clean up completed"
+3 SET XMDUZ="Patch OR*3*158 Post-Init"
+4 SET XMY(.5)=""
if $GET(DUZ)
SET XMY(DUZ)=""
+5 SET XMTEXT="^TMP(""ORTXT"",$J,"
+6 KILL ^TMP("ORTXT",$JOB)
+7 SET I=1
+8 SET ^TMP("ORTXT",$JOB,I)="The database clean-up for patch OR*3*158 has completed."
SET I=I+1
+9 SET ^TMP("ORTXT",$JOB,I)="Below is a listing of what was changed and any possible error messages."
SET I=I+1
+10 SET ^TMP("ORTXT",$JOB,I)=""
SET I=I+1
+11 SET ^TMP("ORTXT",$JOB,I)=CNT_" orders had their provider field updated."
SET I=I+1
+12 SET ^TMP("ORTXT",$JOB,I)=""
SET I=I+1
+13 IF $DATA(ERR)
Begin DoDot:1
+14 SET ^TMP("ORTXT",$JOB,I)="An error occurred that stopped the post-init. It was:"
SET I=I+1
+15 SET ^TMP("ORTXT",$JOB,I)=ERR
SET I=I+1
+16 SET ^TMP("ORTXT",$JOB,I)=""
SET I=I+1
End DoDot:1
+17 IF '$DATA(ERR)
IF 'CNT
SET ^TMP("ORTXT",$JOB,I)="No changes were made to your database."
SET I=I+1
+18 SET ^TMP("ORTXT",$JOB,I)=""
SET I=I+1
+19 SET PKG=0
FOR
SET PKG=$ORDER(^TMP("ORFIX",$JOB,PKG))
if PKG=""
QUIT
Begin DoDot:1
+20 SET ^TMP("ORTXT",$JOB,I)=$PIECE(^DIC(9.4,PKG,0),U)
SET I=I+1
+21 SET ORD=0
FOR
SET ORD=$ORDER(^TMP("ORFIX",$JOB,PKG,ORD))
if ORD=""
QUIT
Begin DoDot:2
+22 SET ^TMP("ORTXT",$JOB,I)=" ORDER #: "_ORD_" "_^TMP("ORFIX",$JOB,PKG,ORD)
SET I=I+1
End DoDot:2
+23 SET ^TMP("ORTXT",$JOB,I)=""
SET I=I+1
End DoDot:1
+24 ;send results
DO ^XMD
+25 KILL ^TMP("ORTXT",$JOB)
+26 QUIT
+27 ;
INSTDT(PATCH) ;Returns installation date patch first installed at site
+1 NEW IEN
+2 ;Get IEN of first installation
SET IEN=$ORDER(^XPD(9.7,"B",PATCH,0))
if '+IEN
QUIT 0
+3 ;Get date of first install
QUIT $PIECE($PIECE($GET(^XPD(9.7,IEN,1)),U),".")
