Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: PRCNEQA1

PRCNEQA1.m

Go to the documentation of this file. 
  1. PRCNEQA1 ;SSI/ALA-Equipment Committee Approval ;[ 09/09/96  3:15 PM ]
  1.  ;;1.0;Equipment/Turn-In Request;;Sep 13, 1996
  1. FAP ;
  1.  S PRCNDIS=1 D LINE
  1. QS K % W !!,"Does request need a final confirmation from responsible CMR Official"
  1.  D YN^DICN
  1.  I %=0 D  G QS
  1.  . W !,"Enter 'Yes' if this request is to be sent to the CMR Offical for a final review"
  1.  . W !,"before a 2237 is to be created.  Enter 'No' if a 2237 should be created without"
  1.  . W !,"further review."
  1.  I %=1 D MSG
  1.  I %<0 S DUOUT=1 Q
  1.  S DIC="^PRCN(413,",DIE=DIC,(DA,D0)=IN
  1.  S DR="6////^S X=STAT;7////^S X=DT;47////^S X=STT;48////^S X=DT;49///@" D ^DIE
  1.  S MSGN=$S(EQXI=1:43,EQXI=2:44,EQXI=3:40,EQXI=4:39,1:"")
  1.  D MES^PRCNMESG
  1.  S D1=0 F  S D1=$O(^PRCN(413,D0,1,D1)) Q:D1'>0  S QTY=$P(^(D1,0),U,5) D ^DIE
  1.  I EQXI>2 G AXT
  1. AXT K DIC,DIE,DR,EANS,%,QTY,D0,D1,DA,PRCNDIS
  1.  Q
  1. LINE ; Display line item information
  1.  W !!,"TRANSACTION #: ",$P(^PRCN(413,IN,0),U)
  1.  S OIN2=$P(^PRCN(413,IN,1,0),U,3)
  1.  F IN2=1:1:OIN2 D  Q:$D(DUOUT)
  1.  . Q:$G(^PRCN(413,IN,1,IN2,0))=""
  1.  . S REQ=$P(^PRCN(413,IN,1,IN2,0),U,5),LST=""
  1.  . S PRCNI=IN,(PRCNJ,PRCNK)=IN2,APP=$S(REQ="":0,1:REQ)
  1.  . S QTY=$P(^PRCN(413,PRCNI,1,PRCNJ,0),U,5),PR=$P(^(0),U,4)
  1.  . W !!,"Qty: ",QTY,?20,"Price: ",PR,?40,"Total: ",QTY*PR,!,"Description:"
  1.  . S PRCNL=0 F  S PRCNL=$O(^PRCN(413,PRCNI,1,PRCNJ,1,PRCNL)) Q:'+PRCNL  W !,"    ",^(PRCNL,0)
  1.  . I $G(PRCNDIS)="" D LINE2
  1.  K OIN2,REQ,QTY,APP,LAPP,DR,PR,DIC,DA,D0,D1,PRCNI,PRCNL,PRCNJ,PRCNK
  1.  K DIR,ST,PRCNN,DLAYGO,LST
  1.  Q
  1. LINE2 ; Display line item & get input
  1.  S DIR(0)="S^AF:Approved and Funded;AP:Approved Pending Funds;DD:Disapproved;DF:Deferred until later"
  1.  S DIR("A")="Select a status code" D ^DIR Q:$G(DIRUT)=1
  1.  S ST=Y
  1.  ;  Decide on actual quantity being decided, may not be same as the
  1.  ;  requested quantity
  1. QUAN W !,"Quantity requested: ",REQ
  1.  W ?40,"Quantity approved: ",APP,"//" R PRCNN:DTIME I '$T G QUAN
  1.  I PRCNN["?" D  G QUAN
  1.  . W !!,"Enter a numeric quantity that is being approved.  It"
  1.  . W !,"does not have to be the same as the requested quantity."
  1.  S:PRCNN="^" DUOUT="^" Q:$D(DUOUT)
  1.  S:PRCNN="" PRCNN=APP S:LST="" LST=ST
  1.  I PRCNN>APP!(PRCNN<1)!(PRCNN'?.N) W $C(7) G QUAN
  1.  I ST'=LST D SPLIT S LST=ST
  1.  I ST=LST S DA=PRCNJ,DA(1)=PRCNI D UPDT
  1.  S LAPP=APP-PRCNN Q:LAPP=0  S APP=LAPP
  1.  G LINE2
  1. UPDT ;  Update the line item/transaction
  1.  S DR="10////^S X=ST;12////^S X=DT;9////^S X=PRCNN"
  1.  S:ST["D" DR=DR_";11;I '$D(^PRCN(413,DA(1),1,DA,3)) W $C(7),!,""Explanation is required!"" S Y=11"
  1.  S (DIC,DIE)="^PRCN(413,"_DA(1)_",1," D ^DIE
  1.  Q
  1. SPLIT ; Split line item based on quantity approved
  1.  S DA(1)=PRCNI,X=$P(^PRCN(413,DA(1),1,PRCNJ,0),U),DIC(0)="L"
  1.  S DIC="^PRCN(413,"_DA(1)_",1,",DLAYGO=413.015
  1.  D FILE^DICN S (PRCNJ,DA)=+Y D COPY
  1.  S DR=".01////^S X=PRCNJ",DIE=DIC D ^DIE
  1.  Q
  1. EXIT K DIC,DIE,DA,%
  1.  Q
  1. COPY ;  Copy data from one line item to new line item
  1.  S %X="^PRCN(413,"_PRCNI_",1,"_PRCNK_",",%Y="^PRCN(413,"_PRCNI_",1,"_PRCNJ_","
  1.  D %XY^%RCR
  1.  K %X,%Y
  1.  Q
  1. MSG ;  Send message to CMR Official for final confirmation
  1.  S MSGN=53 K NOD
  1.  ;  set transaction data into message
  1.  D MES^PRCNMESG
  1.  S DIC="^PRCN(413,",DIE=DIC,(DA,D0)=IN
  1.  S DR="6////^S X=45;7////^S X=DT" D ^DIE
  1.  Q