source: FOIAVistA/trunk/r/ORDER_ENTRY_RESULTS_REPORTING-OR-OCX--ORRC--ORRJ/ORPKFIX.m@ 1757

Last change on this file since 1757 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 2.6 KB
Line 
1ORPKFIX ;HISC/JFR - FIX BAD PACKAGE POINTERS IN ^OR(100 11/7/95 10:00
2 ;;2.5;ORDER ENTRY/RESULTS REPORTING;**37,44**;Jan 08, 1993
3 ; This routine will repoint any orders in file 100 that have a
4 ; different package associated with the order than the protocol
5 ; that created the order.
6EN D DT^DICRW
7 I $D(^TMP("ORPKFIX")) D
8 .W !!,"It appears you may have errored out running this patch before."
9 .W !,"Your count of records corrected will be off but all corrections "
10 .W !,"will be shown if you print the report."
11 .W !! H 2
12 W !,"I'll check your ORDER file for bad PACKAGE file pointers.",!
13 S (ORCNT,ORREC,ORRECNT)=0 F S ORREC=$O(^OR(100,ORREC)) Q:'ORREC D
14 .S ORRECNT=ORRECNT+1 W:'(ORRECNT#1000) "."
15 .S ORPROT=$P($G(^OR(100,ORREC,0)),"^",5) Q:ORPROT'["ORD"
16 .S ORPROTPK=$P($G(^ORD(101,+ORPROT,0)),"^",12),ORDPK=$P($G(^OR(100,ORREC,0)),"^",14)
17 .Q:$G(^OR(100,ORREC,1,1,0))["DC"
18 .I ORPROTPK'=ORDPK D Q
19 ..S ORCNT=ORCNT+1
20 ..S $P(^OR(100,ORREC,0),"^",14)=ORPROTPK
21 ..S X=ORDPK S DIC="^DIC(9.4,",DIC(0)="XN" D ^DIC S ORDPK=$P(Y,"^",2)
22 ..S X=ORPROTPK S DIC="^DIC(9.4,",DIC(0)="XN" D ^DIC S ORPROTPK=$P(Y,"^",2)
23 ..S ^TMP("ORPKFIX",$J,ORREC)=ORREC_"^"_ORDPK_"^"_ORPROTPK
24 W !!,"Finished"
25 W !!,ORCNT," Orders have been fixed."
26 K DIC,ORDPK,ORPROT,ORPROTPK,ORREC,ORRECNT,X,Y
27DEVICE ;PRINT THE REPORT IF YOU WANT
28 W !!,"You can print a list of corrections if you wish.",!
29 S DIR(0)="Y",DIR("A")="Would you like a list",DIR("B")="Y"
30 D ^DIR G:($D(DIRUT)!(Y=0)) QUIT K DIR,Y
31 I ORCNT>50 W !!,"You have ",ORCNT," corrections, you may want to send output to a printer!",!
32 S %ZIS="Q" D ^%ZIS G QUIT:POP
33 I $D(IO("Q")) D QUE G QUIT
34 U IO D PRT
35QUIT D ^%ZISC K %ZIS,DIR,DIROUT,DIRUT,ORCNT,ORJOB,ORNUM,ORNODE,ORPAGE,POP,Y,ZTREQ,ZTQUEUED,^TMP("ORPKFIX")
36 Q
37PRT ;SHOW THE OUTPUT
38 I $D(ZTQUEUED) S ZTREQ="@"
39 S ORPAGE=1 D PAGE
40 I '$D(^TMP("ORPKFIX")) W !,"No corrections made" G QUIT
41 S ORJOB=0 F S ORJOB=$O(^TMP("ORPKFIX",ORJOB)) G:'ORJOB QUIT D G:'$D(ORPAGE) QUIT
42 .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)
43 .. S ORNODE=$G(^TMP("ORPKFIX",ORJOB,ORNUM))
44 .. W !,"Order ",$P(ORNODE,"^")," repointed from ",$E($P(ORNODE,"^",2),1,20)," to ",$E($P(ORNODE,"^",3),1,20)
45 .. Q
46 G QUIT
47PAGE ;NEW PAGE
48 I $E(IOST,1,2)["C-",ORPAGE>1 W ! S DIR(0)="E" D ^DIR K:+Y'>0 ORPAGE Q:'$D(ORPAGE)
49 W @IOF,"Corrections from OR*2.5*37 ORPKFIX",?65,"Page: ",ORPAGE
50 W ! F DASH=1:1:78 W "-"
51 K DASH,DIR Q
52QUE ;QUE THE OUTPUT
53 S ZTRTN="PRT^ORPKFIX",ZTDESC="OR*2.5*37 corrections"
54 S ZTSAVE("^TMP(""ORPKFIX"",")=""
55 D ^%ZTLOAD
56 I '$G(ZTSK) W !!,"Report cancelled!",!
57 E W !,"Report queued!"
58 D HOME^%ZIS
59 K ZTDESC,ZTRTN,ZTSAVE,ZTSK
Note: See TracBrowser for help on using the repository browser.