source: FOIAVistA/trunk/r/IFCAP-PRC-PRX--PRCA--PRCN/PRCX1Q1.m@ 1379

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

initial load of FOIAVistA 6/30/08 version
File size: 4.8 KB
Line 
1PRCX1Q1 ;WISC/PLT-fill in fields 449, 450 of file 410 for carry forward ;4/23/96 13:55
2V ;;5.0;IFCAP;**55**;4/21/95
3 QUIT ;invalid entry
4 ;
5EN ;fill in field 449 and 450 of file 410
6 N PRC,PRCRI,PRCA,PRCB,PRCC,PRCD,PRCE,PRCG,PRCH,PRCF,DMAX
7 N A,B,X,Y
8410 W @IOF D EN^DDIOL("This is for IFCAP patch PRC*5*55 to fill in new fields")
9 D EN^DDIOL("449 & 450 of file 410 for fiscal year 95 only.")
10 D EN^DDIOL("This routine also sets up file 410 entries for all fiscal year 95")
11 D EN^DDIOL("PURCHASE ORDERS without 2237 requests"),EN^DDIOL(" ")
12Q1 D YN^PRC0A(.X,.Y,"Ready to run","O","NO")
13 G:X["^"!(X="")!'Y EXIT
14 D EN^DDIOL("Start convert file 410")
15 S PRCRI(411)=0 F S PRCRI(411)=$O(^PRC(411,PRCRI(411))) QUIT:PRCRI(411)>999999!'PRCRI(411) D
16 . S PRC("SITE")=$P($G(^PRC(411,PRCRI(411),0)),"^") QUIT:'PRC("SITE") D
17 .. QUIT
18 . S PRCB=PRC("SITE")_"-95-1"
19 . S PRCD=PRCB,PRCB=PRC("SITE")_"-95~"
20 . F S PRCD=$O(^PRCS(410,"B",PRCD)) QUIT:PRCD]PRCB!'PRCD S PRCRI(410)=$O(^(PRCD,0)) I PRCRI(410) S PRCE=$G(^PRCS(410,PRCRI(410),0)),A=$G(^(4)),B=$G(^(7)) D
21 .. S PRCG=$P(PRCE,"^",2),PRCF=$P(PRCE,"^",4),PRCH="E"
22 .. W !,$P(PRCE,"^")
23 .. I PRCG="CA" S PRCH="C"
24 .. I PRCG="C" S PRCH="O"
25 .. I PRCG="O" S PRCH=$S($P(A,"^",10)]"":"O",$P(B,"^",6)]"":"A",1:"E") I PRCH="A",$P(A,"^",3)]"",+$P(A,"^",3)=0,$P(A,"^",5)]"" S PRCH="O" W " SECONDARY REQUEST"
26 .. I PRCG="A" S PRCH="O" S:PRCF=1 PRCH=$S($P(A,"^",10)]"":"O",$P(B,"^",6)]"":"A",1:"E")
27 .. ;D ERS410^PRC0G(PRCRI(410)_"^"_PRCH)
28 .. I $P(PRCE,"^",12)="" D EDIT^PRC0B(.X,"410;^PRCS(410,;"_PRCRI(410),"450///^S X=PRCH;449////"_$P($$QTRDATE^PRC0D($P(PRCE,"-",2),$P(PRCE,"-",3)),"^",7))
29 .. S PRCE=$G(^PRCS(410,PRCRI(410),0))
30 .. W ?20,$P(PRCE,"^",11),?30,$P(PRCE,"^",12)
31 .. QUIT
32 . QUIT
33 ;
34 D EN^DDIOL(" ")
35 D EN^DDIOL("FILL-IN NEW FIELD 449 & 450 IN FILE 410 DONE")
36 D EN^DDIOL(" ")
37442 D EN^DDIOL("Start convert purchase orders without requests in file 442")
38 S PRCB=2941000
39 F S PRCB=$O(^PRC(442,"AB",PRCB)) QUIT:PRCB>2951000!'PRCB D
40 . W !,PRCB
41 . S PRCRI(442)="" F S PRCRI(442)=$O(^PRC(442,"AB",PRCB,PRCRI(442))) QUIT:'PRCRI(442) S PRCD=$G(^PRC(442,PRCRI(442),0)),PRCF=$P(PRCD,"^",2) I PRCF-22,PRCF-23,PRCF-24 D:$P($G(^(12)),"^",12)]""&($P($G(^(10,1,0)),"^",2)]"")
42 .. W !,$P(PRCD,"^")
43 .. I $P(PRCD,"^",12)]"" D QUIT
44 ... N A,B
45 ... S A=0 F S A=$O(^PRC(442,PRCRI(442),13,A)) QUIT:'A S PRCRI(410)=$P($G(^(A,0)),"^") I PRCRI(410) S PRCE=$G(^PRCS(410,PRCRI(410),0)) I PRCE,$P(PRCE,"^",12)=""!1 D W " REQUEST-"_PRCRI(410)
46 .... D EDIT^PRC0B(.X,"410;^PRCS(410,;"_PRCRI(410),"450////O;449////"_$P($$QTRDATE^PRC0D($P(PRCE,"-",2),$P(PRCE,"-",3)),"^",7))
47 .... QUIT
48 ... QUIT
49 .. N PRCOBL,PRCOBD,PRCOBA
50 .. N A,B,X,Y,Z
51 .. W " WITHOUT REQUEST"
52 .. S A=$P(PRCD,"^"),PRC("SITE")=$P(A,"-"),PRCOBL=$P(A,"-",2)_"WR"
53 .. I $$DUP(PRC("SITE"),PRCOBL) W " *** DUPLICATE" QUIT
54 .. S PRCOBD=$P(^PRC(442,PRCRI(442),1),"^",15)
55 .. S PRCOBA=$P($G(^PRC(442,PRCRI(442),0)),"^",16) S:PRCOBA="" PRCOBA=0 S:$P($G(^PRC(442,PRCRI(442),7)),"^",2)=45 PRCOBA=0
56 .. I $P($G(^PRC(442,PRCRI(442),0)),"^",2)=25 S PRCOBA=0
57 .. I '$D(^PRCS(410.1,"B",$P(PRCD,"-")_"-"_$E($$DATE^PRC0C(PRCOBD,"I"),3,4)_"-"_$P($P(PRCD,"^",3)," "))) W !," MISSING SEQ#, NOT CONVERTED" QUIT
58 .. D A410^PRC0F(.X,$P(PRCD,"-")_"^"_$P(PRCD,"^",3)_"^A^^"_PRCOBD_"^"_PRCOBA_"^"_PRCOBL)
59 .. S PRCRI(410)=X I PRCRI(410) S PRCE=$G(^PRCS(410,PRCRI(410),0)) D EDIT^PRC0B(.X,"410;^PRCS(410,;"_PRCRI(410),"449////"_$P($$QTRDATE^PRC0D($P(PRCE,"-",2),$P(PRCE,"-",3)),"^",7))
60 .. QUIT
61 . QUIT
62 D EN^DDIOL("PURCHASE ORDERS WITHOUT REQUESTS DONE!")
63417 I 0 D EN^DDIOL(""),EN^DDIOL("Start convert 820 transactions in file 417")
64 I 0 S PRCRI(411)=0 F S PRCRI(411)=$O(^PRC(411,PRCRI(411))) QUIT:PRCRI(411)>999999!'PRCRI(411) D
65 . S PRC("SITE")=$P($G(^PRC(411,PRCRI(411),0)),"^") QUIT:'PRC("SITE") D
66 . S PRCB=PRC("SITE")_"-95-"
67 . S PRCD=PRCB,PRCB=PRC("SITE")_"-~"
68 . F S PRCD=$O(^PRCS(417,"C",PRCD)) QUIT:PRCD]PRCB!'PRCD W !,PRCD S PRCRI(417)="" F S PRCRI(417)=$O(^PRCS(417,"C",PRCD,PRCRI(417))) QUIT:'PRCRI(417) I PRCRI(417) S PRCE=$G(^PRCS(417,PRCRI(417),0)),PRCF=$P($G(^(1)),"^") D
69 .. N PRCOBL,PRCOBD,PRCOBA
70 .. N A,B,X,Y,Z
71 .. S PRCOBA=$P(PRCE,"^",20),PRCOBD=$P($P(PRCE,"^",22),"."),PRCOBL=$P(PRCE,"^",18)_"_820"
72 .. W !,PRCE
73 .. I $G(PRCF) W " *** DUPLICATE" QUIT
74 .. D A410^PRC0F(.X,$P(PRCD,"-")_"^"_$P(PRCD,"-",4)_"^A^^"_PRCOBD_"^"_PRCOBA_"^"_PRCOBL)
75 .. S:X $P(^PRCS(417,PRCRI(417),1),"^")=X
76 .. QUIT
77 . QUIT
78 ;D EN^DDIOL("820 FMS TRANSACTION DONE!")
79 D EN^DDIOL("IFCAP PATCH *5*55 CONVERSION DONE FOR 1995!")
80 D
81 . N A,B,X,Y
82 . S X(1)="IFCAP CARRY FORWARD CONVERSION FOR 1995 DONE! 1995 RUNNING BALNCE REPORT IS SET UP."
83 . S Y(.5)="",Y(DUZ)=""
84 . D MM^PRC0B2("IFCAP CARRY FORWARD CONVERSION FOR 1995 DONE!","X(",.Y)
85EXIT QUIT
86 ;
87DUP(A,B) ;CHECK DUPLICATION FOR 442 CONVERSION
88 N C,D,E
89 S C=""
90 S D="" F S D=$O(^PRCS(410,"D",B,D)) QUIT:'D I D,+$G(^PRCS(410,D,0))=+PRC("SITE") S C=1 QUIT
91 QUIT C
Note: See TracBrowser for help on using the repository browser.