source: FOIAVistA/trunk/r/EQUIPMENT_TURN_IN_REQUEST-PRCN/PRCNEQA1.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: 3.0 KB
Line 
1PRCNEQA1 ;SSI/ALA-Equipment Committee Approval ;[ 09/09/96 3:15 PM ]
2 ;;1.0;Equipment/Turn-In Request;;Sep 13, 1996
3FAP ;
4 S PRCNDIS=1 D LINE
5QS K % W !!,"Does request need a final confirmation from responsible CMR Official"
6 D YN^DICN
7 I %=0 D G QS
8 . W !,"Enter 'Yes' if this request is to be sent to the CMR Offical for a final review"
9 . W !,"before a 2237 is to be created. Enter 'No' if a 2237 should be created without"
10 . W !,"further review."
11 I %=1 D MSG
12 I %<0 S DUOUT=1 Q
13 S DIC="^PRCN(413,",DIE=DIC,(DA,D0)=IN
14 S DR="6////^S X=STAT;7////^S X=DT;47////^S X=STT;48////^S X=DT;49///@" D ^DIE
15 S MSGN=$S(EQXI=1:43,EQXI=2:44,EQXI=3:40,EQXI=4:39,1:"")
16 D MES^PRCNMESG
17 S D1=0 F S D1=$O(^PRCN(413,D0,1,D1)) Q:D1'>0 S QTY=$P(^(D1,0),U,5) D ^DIE
18 I EQXI>2 G AXT
19AXT K DIC,DIE,DR,EANS,%,QTY,D0,D1,DA,PRCNDIS
20 Q
21LINE ; Display line item information
22 W !!,"TRANSACTION #: ",$P(^PRCN(413,IN,0),U)
23 S OIN2=$P(^PRCN(413,IN,1,0),U,3)
24 F IN2=1:1:OIN2 D Q:$D(DUOUT)
25 . Q:$G(^PRCN(413,IN,1,IN2,0))=""
26 . S REQ=$P(^PRCN(413,IN,1,IN2,0),U,5),LST=""
27 . S PRCNI=IN,(PRCNJ,PRCNK)=IN2,APP=$S(REQ="":0,1:REQ)
28 . S QTY=$P(^PRCN(413,PRCNI,1,PRCNJ,0),U,5),PR=$P(^(0),U,4)
29 . W !!,"Qty: ",QTY,?20,"Price: ",PR,?40,"Total: ",QTY*PR,!,"Description:"
30 . S PRCNL=0 F S PRCNL=$O(^PRCN(413,PRCNI,1,PRCNJ,1,PRCNL)) Q:'+PRCNL W !," ",^(PRCNL,0)
31 . I $G(PRCNDIS)="" D LINE2
32 K OIN2,REQ,QTY,APP,LAPP,DR,PR,DIC,DA,D0,D1,PRCNI,PRCNL,PRCNJ,PRCNK
33 K DIR,ST,PRCNN,DLAYGO,LST
34 Q
35LINE2 ; Display line item & get input
36 S DIR(0)="S^AF:Approved and Funded;AP:Approved Pending Funds;DD:Disapproved;DF:Deferred until later"
37 S DIR("A")="Select a status code" D ^DIR Q:$G(DIRUT)=1
38 S ST=Y
39 ; Decide on actual quantity being decided, may not be same as the
40 ; requested quantity
41QUAN W !,"Quantity requested: ",REQ
42 W ?40,"Quantity approved: ",APP,"//" R PRCNN:DTIME I '$T G QUAN
43 I PRCNN["?" D G QUAN
44 . W !!,"Enter a numeric quantity that is being approved. It"
45 . W !,"does not have to be the same as the requested quantity."
46 S:PRCNN="^" DUOUT="^" Q:$D(DUOUT)
47 S:PRCNN="" PRCNN=APP S:LST="" LST=ST
48 I PRCNN>APP!(PRCNN<1)!(PRCNN'?.N) W $C(7) G QUAN
49 I ST'=LST D SPLIT S LST=ST
50 I ST=LST S DA=PRCNJ,DA(1)=PRCNI D UPDT
51 S LAPP=APP-PRCNN Q:LAPP=0 S APP=LAPP
52 G LINE2
53UPDT ; Update the line item/transaction
54 S DR="10////^S X=ST;12////^S X=DT;9////^S X=PRCNN"
55 S:ST["D" DR=DR_";11;I '$D(^PRCN(413,DA(1),1,DA,3)) W $C(7),!,""Explanation is required!"" S Y=11"
56 S (DIC,DIE)="^PRCN(413,"_DA(1)_",1," D ^DIE
57 Q
58SPLIT ; Split line item based on quantity approved
59 S DA(1)=PRCNI,X=$P(^PRCN(413,DA(1),1,PRCNJ,0),U),DIC(0)="L"
60 S DIC="^PRCN(413,"_DA(1)_",1,",DLAYGO=413.015
61 D FILE^DICN S (PRCNJ,DA)=+Y D COPY
62 S DR=".01////^S X=PRCNJ",DIE=DIC D ^DIE
63 Q
64EXIT K DIC,DIE,DA,%
65 Q
66COPY ; Copy data from one line item to new line item
67 S %X="^PRCN(413,"_PRCNI_",1,"_PRCNK_",",%Y="^PRCN(413,"_PRCNI_",1,"_PRCNJ_","
68 D %XY^%RCR
69 K %X,%Y
70 Q
71MSG ; Send message to CMR Official for final confirmation
72 S MSGN=53 K NOD
73 ; set transaction data into message
74 D MES^PRCNMESG
75 S DIC="^PRCN(413,",DIE=DIC,(DA,D0)=IN
76 S DR="6////^S X=45;7////^S X=DT" D ^DIE
77 Q
Note: See TracBrowser for help on using the repository browser.