| 1 | PRCNOTHR ;SSI/ALA-Other request reviewers ;[ 11/04/96  10:17 AM ]
 | 
|---|
| 2 |  ;;1.0;Equipment/Turn-In Request;**1,11**;Sep 13, 1996
 | 
|---|
| 3 | CON ;  Concurring Official's review and approval
 | 
|---|
| 4 |  S DIC="^PRCN(413,",DIC(0)="AEQZ",DIC("S")="I $P(^(0),U,7)=9" D ^DIC
 | 
|---|
| 5 |  K DIC("S") G Q2:Y<0 S (IN,DA)=+Y
 | 
|---|
| 6 |  ;  Check to see if you are one of the concurring officials for
 | 
|---|
| 7 |  ;  this transaction
 | 
|---|
| 8 |  I '$D(^PRCN(413,DA,5)) W $C(7)," ??  No Concurring Officials for this transaction!" G Q2
 | 
|---|
| 9 |  S PRCNDZ=$O(^PRCN(413.3,"B",DUZ,""))
 | 
|---|
| 10 |  I 'PRCNDZ W !,$C(7),"  ??  You are not a Concurring Official!" K PRCNDZ G CON
 | 
|---|
| 11 |  I '$D(^PRCN(413,DA,5,"B",PRCNDZ)) W !,$C(7),"  ??  You are not a Concurring Official for this transaction!" K PRCNDZ G CON
 | 
|---|
| 12 |  S NUM=$O(^PRCN(413,DA,5,"B",PRCNDZ,""))
 | 
|---|
| 13 |  S D0=DA,D1=NUM,PRCNUSR=5 D SETUP^PRCNPRNT
 | 
|---|
| 14 | ASK K % W !!,"Do you approve this Equipment Request" D YN^DICN
 | 
|---|
| 15 |  S PRCNANS=% G Q2:%=-1
 | 
|---|
| 16 |  I %=0 W !,"Answer 'Y' or 'N'." G ASK
 | 
|---|
| 17 |  S $P(^PRCN(413,DA,5,NUM,0),U,2)=$S(%=2:"N",1:"Y"),$P(^(0),U,3)=DT
 | 
|---|
| 18 | EX S ^PRCN(413,DA,5,NUM,1,0)="^^"_DT,DIWETXT="COMMENTS"
 | 
|---|
| 19 |  W !,"COMMENTS"
 | 
|---|
| 20 |  NEW DIC S DIC="^PRCN(413,"_DA_",5,"_NUM_",1," D EN^DIWE
 | 
|---|
| 21 |  I '$D(^PRCN(413,DA,5,NUM,1,1)) W !,$C(7),"Please enter an explanation of your decision." G EX
 | 
|---|
| 22 |  D ES^PRCNUTL I $G(FAIL)<1 G EXIT
 | 
|---|
| 23 | CS ; Check if all concurring officials have answered.
 | 
|---|
| 24 |  S (DIS,N,SUB,TOT)=0 F  S N=$O(^PRCN(413,DA,5,N)) Q:'N  D
 | 
|---|
| 25 |  . S STAT=$P(^PRCN(413,DA,5,N,0),U,2),TOT=TOT+1
 | 
|---|
| 26 |  . S:STAT]"" ANS(STAT)=$G(ANS(STAT))+1,SUB=SUB+1
 | 
|---|
| 27 |  I SUB'<TOT D
 | 
|---|
| 28 |  . I (+$G(ANS("Y"))/TOT*100)<50 D  Q:DIS
 | 
|---|
| 29 |  .. S DIE=413,DR="6////^S X=15;7////^S X=DT" D ^DIE
 | 
|---|
| 30 |  .. S KEY="PRCNPPM" D FND^PRCNMESG S XMDUZ="CONCURRING OFFICIALS"
 | 
|---|
| 31 |  .. S XMB="PRCNPPM2",XMB(1)=$P(^PRCN(413,DA,0),U),MSGN=99
 | 
|---|
| 32 |  .. D MES^PRCNMESG
 | 
|---|
| 33 |  .. S DIS=1
 | 
|---|
| 34 |  . S DIE=413,DR="6////^S X=32;7////^S X=DT" D ^DIE
 | 
|---|
| 35 | Q2 K ANS,CFL,D0,D1,FAIL,STAT,TOT,DIS,SUB,XMB,DIC,XMDUZ,PRCNCMR,PRCNRQS
 | 
|---|
| 36 |  I $G(PRCNANS)=1 W !!,"Transaction will be returned to PPM for final review",!
 | 
|---|
| 37 | EXIT K DIC,DIE,DA,DR,X,Y,PRCNUSR,IN,XMY,XMTEXT,C,J,N,NUM,FAIL,%,D,MSGN
 | 
|---|
| 38 |  K PRCNANS,DIWETXT,PRCNDZ
 | 
|---|
| 39 |  Q
 | 
|---|