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

ORPKFIX.m

Go to the documentation of this file.
  1. ORPKFIX ;HISC/JFR - FIX BAD PACKAGE POINTERS IN ^OR(100 11/7/95 10:00
  1. ;;2.5;ORDER ENTRY/RESULTS REPORTING;**37,44**;Jan 08, 1993
  1. ; This routine will repoint any orders in file 100 that have a
  1. ; different package associated with the order than the protocol
  1. ; that created the order.
  1. EN D DT^DICRW
  1. I $D(^TMP("ORPKFIX")) D
  1. .W !!,"It appears you may have errored out running this patch before."
  1. .W !,"Your count of records corrected will be off but all corrections "
  1. .W !,"will be shown if you print the report."
  1. .W !! H 2
  1. W !,"I'll check your ORDER file for bad PACKAGE file pointers.",!
  1. S (ORCNT,ORREC,ORRECNT)=0 F S ORREC=$O(^OR(100,ORREC)) Q:'ORREC D
  1. .S ORRECNT=ORRECNT+1 W:'(ORRECNT#1000) "."
  1. .S ORPROT=$P($G(^OR(100,ORREC,0)),"^",5) Q:ORPROT'["ORD"
  1. .S ORPROTPK=$P($G(^ORD(101,+ORPROT,0)),"^",12),ORDPK=$P($G(^OR(100,ORREC,0)),"^",14)
  1. .Q:$G(^OR(100,ORREC,1,1,0))["DC"
  1. .I ORPROTPK'=ORDPK D Q
  1. ..S ORCNT=ORCNT+1
  1. ..S $P(^OR(100,ORREC,0),"^",14)=ORPROTPK
  1. ..S X=ORDPK S DIC="^DIC(9.4,",DIC(0)="XN" D ^DIC S ORDPK=$P(Y,"^",2)
  1. ..S X=ORPROTPK S DIC="^DIC(9.4,",DIC(0)="XN" D ^DIC S ORPROTPK=$P(Y,"^",2)
  1. ..S ^TMP("ORPKFIX",$J,ORREC)=ORREC_"^"_ORDPK_"^"_ORPROTPK
  1. W !!,"Finished"
  1. W !!,ORCNT," Orders have been fixed."
  1. K DIC,ORDPK,ORPROT,ORPROTPK,ORREC,ORRECNT,X,Y
  1. DEVICE ;PRINT THE REPORT IF YOU WANT
  1. W !!,"You can print a list of corrections if you wish.",!
  1. S DIR(0)="Y",DIR("A")="Would you like a list",DIR("B")="Y"
  1. D ^DIR G:($D(DIRUT)!(Y=0)) QUIT K DIR,Y
  1. I ORCNT>50 W !!,"You have ",ORCNT," corrections, you may want to send output to a printer!",!
  1. S %ZIS="Q" D ^%ZIS G QUIT:POP
  1. I $D(IO("Q")) D QUE G QUIT
  1. U IO D PRT
  1. QUIT D ^%ZISC K %ZIS,DIR,DIROUT,DIRUT,ORCNT,ORJOB,ORNUM,ORNODE,ORPAGE,POP,Y,ZTREQ,ZTQUEUED,^TMP("ORPKFIX")
  1. Q
  1. PRT ;SHOW THE OUTPUT
  1. I $D(ZTQUEUED) S ZTREQ="@"
  1. S ORPAGE=1 D PAGE
  1. I '$D(^TMP("ORPKFIX")) W !,"No corrections made" G QUIT
  1. S ORJOB=0 F S ORJOB=$O(^TMP("ORPKFIX",ORJOB)) G:'ORJOB QUIT D G:'$D(ORPAGE) QUIT
  1. .S ORNUM=0 F S ORNUM=$O(^TMP("ORPKFIX",ORJOB,ORNUM)) Q:'ORNUM D I $Y>(IOSL-5) S ORPAGE=ORPAGE+1 D PAGE Q:'$D(ORPAGE)
  1. .. S ORNODE=$G(^TMP("ORPKFIX",ORJOB,ORNUM))
  1. .. W !,"Order ",$P(ORNODE,"^")," repointed from ",$E($P(ORNODE,"^",2),1,20)," to ",$E($P(ORNODE,"^",3),1,20)
  1. .. Q
  1. G QUIT
  1. PAGE ;NEW PAGE
  1. I $E(IOST,1,2)["C-",ORPAGE>1 W ! S DIR(0)="E" D ^DIR K:+Y'>0 ORPAGE Q:'$D(ORPAGE)
  1. W @IOF,"Corrections from OR*2.5*37 ORPKFIX",?65,"Page: ",ORPAGE
  1. W ! F DASH=1:1:78 W "-"
  1. K DASH,DIR Q
  1. QUE ;QUE THE OUTPUT
  1. S ZTRTN="PRT^ORPKFIX",ZTDESC="OR*2.5*37 corrections"
  1. S ZTSAVE("^TMP(""ORPKFIX"",")=""
  1. D ^%ZTLOAD
  1. I '$G(ZTSK) W !!,"Report cancelled!",!
  1. E W !,"Report queued!"
  1. D HOME^%ZIS
  1. K ZTDESC,ZTRTN,ZTSAVE,ZTSK