ORY166.m

ORY166 ;SLC/DAN ;12/4/02  08:06

 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**166**;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^ORY166",ZTDESC="Patch OR*3*166 database clean up",ZTIO="",ZTSAVE("DUZ")="",ZTDTH=""

 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

 S CNT=0

 I IEN=-1 S ERR="No orders in date range" Q  ;No orders to review

 F  S IEN=$O(^OR(100,IEN)) Q:'+IEN  D

 .Q:'$D(^OR(100,IEN,0))  Q:+$P(^OR(100,IEN,0),U,4)'=0  ;Quit if 0 node missing or if order is ok (provider '= 0)

 .S PKGNUM=$P(^OR(100,IEN,0),U,14) Q:PKGNUM=""  ;Stop if no package entered

 .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($G(^OR(100,IEN,3)),U,9)

 I '+PARENT Q 0  ;No parent order found

 S PROV=$P($G(^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($G(^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*166 Clean up completed"

 S XMDUZ="Patch OR*3*166 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*166 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

ORY166    ;SLC/DAN ;12/4/02  08:06

 +1       ;;3.0;ORDER ENTRY/RESULTS REPORTING;**166**;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^ORY166"

           SET ZTDESC="Patch OR*3*166 database clean up"

           SET ZTIO=""

           SET ZTSAVE("DUZ")=""

           SET ZTDTH=""

 +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        SET CNT=0

 +6       ;No orders to review

           IF IEN=-1

               SET ERR="No orders in date range"

               QUIT 

 +7        FOR 

               SET IEN=$ORDER(^OR(100,IEN))

               IF '+IEN

                   QUIT 

               Begin DoDot:1

 +8       ;Quit if 0 node missing or if order is ok (provider '= 0)

                   IF '$DATA(^OR(100,IEN,0))

                       QUIT 

                   IF +$PIECE(^OR(100,IEN,0),U,4)'=0

                       QUIT 

 +9       ;Stop if no package entered

                   SET PKGNUM=$PIECE(^OR(100,IEN,0),U,14)

                   IF PKGNUM=""

                       QUIT 

 +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($GET(^OR(100,IEN,3)),U,9)

 +2       ;No parent order found

           IF '+PARENT

               QUIT 0

 +3        SET PROV=$PIECE($GET(^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($GET(^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*166 Clean up completed"

 +3        SET XMDUZ="Patch OR*3*166 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*166 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),".")