PRCNEQAP ;SSI/ALA-Equipment Committee Approval ;[ 09/11/96 1:59 PM ]
;;1.0;Equipment/Turn-In Request;;Sep 13, 1996
EN ;Ask for approval type
S DIR("A")="Select Approval Methodology"
S DIR("A",2)=" "
S DIR("A",1)="Select the appropriate approval methodology to process multiple transactions."
S DIR("A",3)="Option 1 - APPROVE/FUNDED ALL LINE ITEMS should be used when all line items in a"
S DIR("A",4)="transaction have been designated 'approve and funded' and are ready for 2237"
S DIR("A",5)="processing."
S DIR("A",6)="Option 2 - APPROVE/PENDING ALL LINE ITEMS should be used when all line items"
S DIR("A",7)="in a transaction have been approved but funding is still pending."
S DIR("A",8)="Option 3 - DISAPPROVE ALL LINE ITEMS should be used when all lines items in a"
S DIR("A",9)="transaction have not been approved."
S DIR("A",10)="Option 4 - DEFER ALL LINE ITEMS should be used when all line items in a"
S DIR("A",11)="transaction should be deferred until a later decision cycle."
S DIR("A",12)="Option 5 - Process Individual Line Items should be used when some line items"
S DIR("A",13)="in the same transaction have been approved and some have not been approved."
S DIR("A",14)=" "
S DIR(0)="S^1:APPROVE/FUNDED ALL LINE ITEMS;2:APPROVE/PENDING ALL LINE ITEMS;3:DISAPPROVE ALL LINE ITEMS;4:DEFER ALL LINE ITEMS;5:PROCESS INDIVIDUAL LINE ITEMS"
D ^DIR G EXIT:$G(DIRUT)=1 S EQXI=X,EQXT=Y(0)
BEG ;
D ^PRCNEQA2 G EXIT:$G(DIRUT)=1!($G(VTI)="^")
S STAT=$S(EQXI=1:19,EQXI=2:18,EQXI=3:16,EQXI=4:17,1:"")
S STT=$S(EQXI=1:"AF",EQXI=2:"AP",EQXI=3:"DD",EQXI=4:"DF",1:"")
S MSGN=$S(EQXI=1:43,EQXI=2:44,EQXI=3:40,EQXI=4:39,1:"")
S IN="" F S IN=$O(^TMP($J,"APP","D",IN)) Q:IN="" D I $G(DUOUT)=1 S DUOUT=0 G BEG
. I EQXI<5 D FAP^PRCNEQA1 Q:$G(DUOUT)=1
. I EQXI=5 D LINE^PRCNEQA1 Q:$G(DUOUT)=1!($G(DTOUT)=1) D ^PRCNEQS
. I $G(IN)'="" S PSER="" F S PSER=$O(^PRCN(413,"P",PSER)) Q:PSER="" D
.. S RNK="" F S RNK=$O(^PRCN(413,"P",PSER,RNK)) Q:RNK="" K ^PRCN(413,"P",PSER,RNK,IN)
. K PSER,X,RNK
EXIT K DIR,DIRUT,LTOTAL,PN,PRCNT,PRCNZ,SERV,TOTAL,TQTY,XX,PRCNZ,PRCNT,Y
K ^TMP($J),EQXI,EQXT,EQLS,PRCNI,PRCNJ,PRCNK,PRCNN,PRCNT,PRCNL,SK,NTRN
K ER,FN,IN,IN2,MSGN,STAT,STT,COST,D0,D1,I,PRCNX,D,DA,EQDA,J,LBN,LPRI
K OLDPRI,PRIMAX,X,XMDT
Q
HDR(X) ; Prints NX header and up to 18 lines of NX data
D:'$D(IOF) HOME^%ZIS
W @IOF,?15,EQXT_" in the following Equipment Requests",!!
W !,"Num#",?7,"Rank",?13,"Request #",?33,"Service",?60,"# Items",?70,"Amount",!
F I=1:1:79 W "-"
F Y=X:1:X+17 Q:'$D(^TMP($J,"APP",Y)) S D0=^TMP($J,"APP",Y) D
. D GETSUMS W !,Y,?7,$P($G(^PRCN(413,D0,6)),U,3)
. W ?13,$P($G(^PRCN(413,D0,0)),U) S SERV=$P(^DIC(49,$P(^(0),U,3),0),U)
. W ?33,$E(SERV,1,25),?62,TQTY,?70,"$",$J(TOTAL,8,2)
Q
GETSUMS ; Get line item total & display stuff
S (D1,TQTY,TOTAL,LTOTAL)=0 NEW Y
F S D1=$O(^PRCN(413,D0,1,D1)) Q:'+D1 D S TQTY=TQTY+1
. S DR=15,DR(413.015)=6,DIQ(0)="C",DIQ="LBTOT"
. S DIC=413,DA=D0,DA(1)=D1,DA(413.015)=D1 NEW D1
. D EN^DIQ1
. S LBN="" F S LBN=$O(LBTOT(413.015,LBN)) Q:LBN="" D
.. S X=$G(LBTOT(413.015,LBN,6))
.. S LTOTAL=LTOTAL+X
. K DR,DIQ,LBTOT,DIC,X
S TOTAL=TOTAL+LTOTAL F FN=20,22,24,53,54,60,63,65,66 D
. S:FN<25 I=2,PN=FN-15 S:FN>25 I=7,PN=FN-51
. S COST=$P($G(^PRCN(413,D0,I)),U,PN),TOTAL=TOTAL+COST
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRCNEQAP 3340 printed Oct 16, 2024@17:55:07 Page 2
PRCNEQAP ;SSI/ALA-Equipment Committee Approval ;[ 09/11/96 1:59 PM ]
+1 ;;1.0;Equipment/Turn-In Request;;Sep 13, 1996
EN ;Ask for approval type
+1 SET DIR("A")="Select Approval Methodology"
+2 SET DIR("A",2)=" "
+3 SET DIR("A",1)="Select the appropriate approval methodology to process multiple transactions."
+4 SET DIR("A",3)="Option 1 - APPROVE/FUNDED ALL LINE ITEMS should be used when all line items in a"
+5 SET DIR("A",4)="transaction have been designated 'approve and funded' and are ready for 2237"
+6 SET DIR("A",5)="processing."
+7 SET DIR("A",6)="Option 2 - APPROVE/PENDING ALL LINE ITEMS should be used when all line items"
+8 SET DIR("A",7)="in a transaction have been approved but funding is still pending."
+9 SET DIR("A",8)="Option 3 - DISAPPROVE ALL LINE ITEMS should be used when all lines items in a"
+10 SET DIR("A",9)="transaction have not been approved."
+11 SET DIR("A",10)="Option 4 - DEFER ALL LINE ITEMS should be used when all line items in a"
+12 SET DIR("A",11)="transaction should be deferred until a later decision cycle."
+13 SET DIR("A",12)="Option 5 - Process Individual Line Items should be used when some line items"
+14 SET DIR("A",13)="in the same transaction have been approved and some have not been approved."
+15 SET DIR("A",14)=" "
+16 SET DIR(0)="S^1:APPROVE/FUNDED ALL LINE ITEMS;2:APPROVE/PENDING ALL LINE ITEMS;3:DISAPPROVE ALL LINE ITEMS;4:DEFER ALL LINE ITEMS;5:PROCESS INDIVIDUAL LINE ITEMS"
+17 DO ^DIR
if $GET(DIRUT)=1
GOTO EXIT
SET EQXI=X
SET EQXT=Y(0)
BEG ;
+1 DO ^PRCNEQA2
if $GET(DIRUT)=1!($GET(VTI)="^")
GOTO EXIT
+2 SET STAT=$SELECT(EQXI=1:19,EQXI=2:18,EQXI=3:16,EQXI=4:17,1:"")
+3 SET STT=$SELECT(EQXI=1:"AF",EQXI=2:"AP",EQXI=3:"DD",EQXI=4:"DF",1:"")
+4 SET MSGN=$SELECT(EQXI=1:43,EQXI=2:44,EQXI=3:40,EQXI=4:39,1:"")
+5 SET IN=""
FOR
SET IN=$ORDER(^TMP($JOB,"APP","D",IN))
if IN=""
QUIT
Begin DoDot:1
+6 IF EQXI<5
DO FAP^PRCNEQA1
if $GET(DUOUT)=1
QUIT
+7 IF EQXI=5
DO LINE^PRCNEQA1
if $GET(DUOUT)=1!($GET(DTOUT)=1)
QUIT
DO ^PRCNEQS
+8 IF $GET(IN)'=""
SET PSER=""
FOR
SET PSER=$ORDER(^PRCN(413,"P",PSER))
if PSER=""
QUIT
Begin DoDot:2
+9 SET RNK=""
FOR
SET RNK=$ORDER(^PRCN(413,"P",PSER,RNK))
if RNK=""
QUIT
KILL ^PRCN(413,"P",PSER,RNK,IN)
End DoDot:2
+10 KILL PSER,X,RNK
End DoDot:1
IF $GET(DUOUT)=1
SET DUOUT=0
GOTO BEG
EXIT KILL DIR,DIRUT,LTOTAL,PN,PRCNT,PRCNZ,SERV,TOTAL,TQTY,XX,PRCNZ,PRCNT,Y
+1 KILL ^TMP($JOB),EQXI,EQXT,EQLS,PRCNI,PRCNJ,PRCNK,PRCNN,PRCNT,PRCNL,SK,NTRN
+2 KILL ER,FN,IN,IN2,MSGN,STAT,STT,COST,D0,D1,I,PRCNX,D,DA,EQDA,J,LBN,LPRI
+3 KILL OLDPRI,PRIMAX,X,XMDT
+4 QUIT
HDR(X) ; Prints NX header and up to 18 lines of NX data
+1 if '$DATA(IOF)
DO HOME^%ZIS
+2 WRITE @IOF,?15,EQXT_" in the following Equipment Requests",!!
+3 WRITE !,"Num#",?7,"Rank",?13,"Request #",?33,"Service",?60,"# Items",?70,"Amount",!
+4 FOR I=1:1:79
WRITE "-"
+5 FOR Y=X:1:X+17
if '$DATA(^TMP($JOB,"APP",Y))
QUIT
SET D0=^TMP($JOB,"APP",Y)
Begin DoDot:1
+6 DO GETSUMS
WRITE !,Y,?7,$PIECE($GET(^PRCN(413,D0,6)),U,3)
+7 WRITE ?13,$PIECE($GET(^PRCN(413,D0,0)),U)
SET SERV=$PIECE(^DIC(49,$PIECE(^(0),U,3),0),U)
+8 WRITE ?33,$EXTRACT(SERV,1,25),?62,TQTY,?70,"$",$JUSTIFY(TOTAL,8,2)
End DoDot:1
+9 QUIT
GETSUMS ; Get line item total & display stuff
+1 SET (D1,TQTY,TOTAL,LTOTAL)=0
NEW Y
+2 FOR
SET D1=$ORDER(^PRCN(413,D0,1,D1))
if '+D1
QUIT
Begin DoDot:1
+3 SET DR=15
SET DR(413.015)=6
SET DIQ(0)="C"
SET DIQ="LBTOT"
+4 SET DIC=413
SET DA=D0
SET DA(1)=D1
SET DA(413.015)=D1
NEW D1
+5 DO EN^DIQ1
+6 SET LBN=""
FOR
SET LBN=$ORDER(LBTOT(413.015,LBN))
if LBN=""
QUIT
Begin DoDot:2
+7 SET X=$GET(LBTOT(413.015,LBN,6))
+8 SET LTOTAL=LTOTAL+X
End DoDot:2
+9 KILL DR,DIQ,LBTOT,DIC,X
End DoDot:1
SET TQTY=TQTY+1
+10 SET TOTAL=TOTAL+LTOTAL
FOR FN=20,22,24,53,54,60,63,65,66
Begin DoDot:1
+11 if FN<25
SET I=2
SET PN=FN-15
if FN>25
SET I=7
SET PN=FN-51
+12 SET COST=$PIECE($GET(^PRCN(413,D0,I)),U,PN)
SET TOTAL=TOTAL+COST
End DoDot:1
+13 QUIT
