- 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 Mar 13, 2025@20:58:58 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
