source: WorldVistAEHR/trunk/r/IFCAP-PRC-PRX--PRCA--PRCN/PRC5B6.m@ 789

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

initial load of WorldVistAEHR

File size: 3.5 KB
Line 
1PRC5B6 ;WISC/PLT-CORRECT ISSUE BOOK BALANCE BY QUARTERS FOR FY-1995 ONLY ;
2V ;;5.0;IFCAP;**27**;4/21/95
3 QUIT ;invalid entry
4 ;
5EN ;CORRECT ISSUE BOOK BALANCE
6 N PRC,PRCRI,PRCA,PRCB,PRCC,PRCD,PRCG,PRCH
7 N A,B,X,Y
8 W @IOF D EN^DDIOL("CONVERT POSTED ISSUE BOOK BALANCE FOR IFCAP V5 INSTALLATION QUARTER WITH V4 RECORDS ONLY")
9Q1 D DT^PRC0A(.X,.Y,"For IFCAP v4 -> v5 Installation Date","O","")
10 G:X["^"!(X="") EXIT
11 S PRCA=$$DATE^PRC0C(Y,"I")
12Q2 D YN^PRC0A(.X,.Y,"CONVERT POSTED ISSUE BOOK REQUEST FOR "_$P(PRCA,"^")_" QTR "_$P(PRCA,"^",2),"O","NO")
13 G:X["^"!(X="")!'Y Q1
14EN1 S PRCRI(410.5)=0 F S PRCRI(410.5)=$O(^PRCS(410.5,PRCRI(410.5))) Q:'PRCRI(410.5) S A=$G(^(PRCRI(410.5),0)) QUIT:A["ISSUE BOOK"
15 I $G(PRCRI(410.5))'=5 D EN^DDIOL("ISSUE BOOK form type code is not 5 in file 410.5") G EXIT
16 S PRCRI(442.3)=$O(^PRCD(442.3,"C",40,0))
17 I 'PRCRI(442.3) D EN^DDIOL("Issue Book complete status is not in file 442.3") G EXIT
18 D EN^DDIOL("ISSUE BOOK CONVERTING FOR OLD IFCAP V4 RECORDS STARTS")
19 S PRCRI(411)=0 F S PRCRI(411)=$O(^PRC(411,PRCRI(411))) QUIT:PRCRI(411)>999999!'PRCRI(411) D
20 . S PRC("SITE")=$P($G(^PRC(411,PRCRI(411),0)),"^") QUIT:'PRC("SITE")
21 . S PRCB=PRC("SITE")_"-"_$E(PRCA,3,4)_"-"_$P(PRCA,"^",2)_"-",PRCC=PRCB_"~"
22 . S PRCD=PRCB
23 . ;check form type 5 and status 40 for final post
24 . F S PRCD=$O(^PRCS(410,"B",PRCD)) Q:PRCD=""!(PRCD]PRCC) S PRCRI(410)=$O(^(PRCD,0)) I PRCRI(410) S PRCF=$G(^PRCS(410,PRCRI(410),0)) I $P(PRCF,"^",4)=PRCRI(410.5),$P($G(^(10)),"^",4)=PRCRI(442.3) D
25 .. S PRCF=$G(^PRCS(410,PRCRI(410),445)),PRCG=$G(^(4)),PRCH=$G(^(9)),PRCI=$G(^(10))
26 .. I PRCF="",$P(PRCH,"^",3)]"",$P(PRCI,"^",4)=$O(^PRCD(442.3,"C",40,0)) D IB
27 . QUIT
28 ;
29 D EN^DDIOL(" ")
30 D EN^DDIOL("ISSUE BOOK CONVERTING FOR OLD IFCAP V4 RECORDS ENDS")
31 D EN^DDIOL(" ")
32 D EN^DDIOL(" Any IB transactions followed by a printed message 'IB obligation #/amount...'")
33 D EN^DDIOL("were not converted because the Obligation Data was not entered for these IBs.")
34EXIT QUIT
35 ;
36EN2 ;called from prc5b
37 N PRC,PRCRI,PRCA,PRCB,PRCC,PRCD,PRCG,PRCH
38 N A,B,X,Y
39 S PRCA=$$DATE^PRC0C("N","E")
40 G EN1
41 ;
42IB ;process ib txn
43 S $P(PRCF,"^")=$P(PRCG,"^",5),$P(PRCF,"^",3)=$P(PRCG,"^",3)
44 W !,PRCD,?20,$P(PRCF,"^"),?30,"$",$P(PRCF,"^",3)
45 I $P(PRCF,"^",1)=""!($P(PRCF,"^",3)="") W " IB obligation #/amount not entered by using OBLIGATION DATA option in v4" QUIT
46 S TOTALSAL=$P(PRCF,"^",3)
47 D IVDATA(PRCRI(410),"")
48 S PRCPDA=PRCRI(410)
49 I $P($G(^PRC(420,PRCPPSTA,1,PRCPPFCP,0)),"^",12)=4 W ?40,"Canteen, not processed" I 1
50 E S ^PRCS(410,PRCRI(410),445)=PRCF D IB^PRCS0B(PRCPPSTA_"^"_PRCPWSTA,PRCPPFCP_"^"_PRCPWFCP,PRCPDA,TOTALSAL_"^"_TOTALSAL) W ?40,"Processed"
51 QUIT
52 ;
53IVDATA(TRANDA,INVPT) ; get fund control point data for iv doc
54 ; tranda=issue book ien; invpt=whse inventory point
55 N PRC,TRANNO
56 S TRANNO=$P($G(^PRCS(410,TRANDA,0)),"^")
57 D:$G(INVPT)=""
58 . N A
59 . S A=0 F S A=$O(^PRCP(445,"AC","W",A)) Q:'A I +$G(^PRCP(445,+A,0))=$P(TRANNO,"-",1) S INVPT=A QUIT
60 . QUIT
61 I INVPT="" W " Warehouse is not defined for this station" QUIT
62 ; seller=whse data
63 S PRCPWSTA=$P($P($G(^PRCP(445,INVPT,0)),"^"),"-")
64 S PRCPWFCP=+$O(^PRC(420,"AE",INVPT,PRCPWSTA,0))
65 S PRCPWBFY=$$BBFY^PRCSUT(PRCPWSTA,$P(TRANNO,"-",2),PRCPWFCP,1)
66 ; buyer data
67 S PRCPPSTA=$P(TRANNO,"-")
68 S PRCPPFCP=+$P($G(^PRCS(410,TRANDA,3)),"^") I 'PRCPPFCP S PRCPPFCP=+$P(TRANNO,"-",4)
69 S PRCPPBFY=$P($G(^PRCS(410,TRANDA,3)),"^",11) I PRCPPBFY'="" S PRCPPBFY=(17+$E(PRCPPBFY))_$E(PRCPPBFY,2,3)
70 I PRCPPBFY="" S PRCPPBFY=$$BBFY^PRCSUT(PRCPPSTA,$P(TRANNO,"-",2),PRCPPFCP,1),$P(^PRCS(410,TRANDA,3),"^",11)=$P($$DATE^PRC0C(PRCPPBFY,"E"),"^",7) W "*"
71 QUIT
Note: See TracBrowser for help on using the repository browser.