[613] | 1 | PRCNEQA1 ;SSI/ALA-Equipment Committee Approval ;[ 09/09/96 3:15 PM ]
|
---|
| 2 | ;;1.0;Equipment/Turn-In Request;;Sep 13, 1996
|
---|
| 3 | FAP ;
|
---|
| 4 | S PRCNDIS=1 D LINE
|
---|
| 5 | QS 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
|
---|
| 19 | AXT K DIC,DIE,DR,EANS,%,QTY,D0,D1,DA,PRCNDIS
|
---|
| 20 | Q
|
---|
| 21 | LINE ; 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
|
---|
| 35 | LINE2 ; 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
|
---|
| 41 | QUAN 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
|
---|
| 53 | UPDT ; 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
|
---|
| 58 | SPLIT ; 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
|
---|
| 64 | EXIT K DIC,DIE,DA,%
|
---|
| 65 | Q
|
---|
| 66 | COPY ; 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
|
---|
| 71 | MSG ; 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
|
---|