PRCNSERP ;SSI/ALA-Service Priority Report ;[ 02/04/97 6:44 PM ]
;;1.0;PRCN;**3,7**;Sep 13, 1996
EN ; Begin report by selecting a service
S DIR(0)="SM^O:Select One Service;A:Select All Services",DIR("A")="Select Print Type "
D ^DIR K DIR S VTI=$TR(X,"ao","AO") I VTI["^" G EXIT
I VTI="O" D SRV G EXIT:$G(SRV)=""
S $P(LIN,"-",80)="",PG=0
S %ZIS="MQ" D ^%ZIS G EXIT:POP>0
I $D(IO("Q")) D G EXIT
. S ZTRTN="BEG^PRCNSERP",ZTDESC="Service Priority Report"
. S ZTSAVE("VTI")="",ZTSAVE("LIN")="",ZTSAVE("PG")="",ZTSAVE("SRVNM")=""
. I $G(SRV)'="" S ZTSAVE("SRV")=""
. D ^%ZTLOAD,HOME^%ZIS K IO("Q"),ZTSK,%ZTLOAD,ZTREQ
I $E(IOST)="P" U IO
BEG I VTI="O" S PRI="",TOTAL=0 D HDR G PRI
S SRV=""
ALL S SRV=$O(^PRCN(413,"P",SRV)) I SRV="" D CONT G EXIT
S PRI="",TOTAL=0,SRVNM=$P(^DIC(49,SRV,0),U) D Q:$G(PRCNC)'=""
. I $E(IOST)'="P",PG>0 D Q:$G(PRCNC)'=""
. . R !,"Press RETURN to continue or '^' to quit. ",PRCNC:DTIME S:'$T PRCNC=U
. . K:PRCNC'?1"^".E PRCNC
. D HDR
PRI S PRI=$O(^PRCN(413,"P",SRV,PRI))
I PRI="" G ALL:VTI'="O" I VTI="O" D CONT G EXIT
S TRN=""
TRN S TRN=$O(^PRCN(413,"P",SRV,PRI,TRN)) G PRI:TRN=""
S PRCNDAT0=$G(^PRCN(413,TRN,0)) I PRCNDAT0="" K ^PRCN(413,"P",SRV,PRI,TRN) G TRN
S PRCNL=$P(PRCNDAT0,U,9),PRCNLDD=$P(^DD(413,8,0),U,3)
S PRCNF="" F LL=1:1 Q:$P(PRCNLDD,";",LL)="" I $P(PRCNLDD,";",LL)[PRCNL_":" S PRCNF=$P($P(PRCNLDD,";",LL),":",2) Q
I $G(PRCNC)'="" D EXIT Q
W !,$P(PRCNDAT0,U),?20,PRI,?40,$E(PRCNF,1,8)
S NL=NL+1 D CHKPG G EXIT:$G(PRCNC)'=""
S RQ=0 F S RQ=$O(^PRCN(413,TRN,1,RQ)) Q:RQ'>0 D
. S PRCNIT0=^PRCN(413,TRN,1,RQ,0),COST=$P(PRCNIT0,U,4),QTY=$P(PRCNIT0,U,5)
. S SBTOT=COST*QTY,TOTAL=TOTAL+SBTOT
. S PRCNL=$P(PRCNDAT0,U,9),PRCNLDD=$P(^DD(413.015,8,0),U,3)
. S PRCNF="" F LL=1:1 Q:$P(PRCNLDD,";",LL)="" I $P(PRCNLDD,";",LL)[PRCNL_":" S PRCNF=$P($P(PRCNLDD,";",LL),":",2) Q
. D ITD
G TRN
SRV S DIC(0)="AEQZ",DIC="^DIC(49," D ^DIC Q:+Y<0
S SRV=+Y,SRVNM=$P(Y,U,2) K DIC,Y
Q
CONT Q:$G(PRCNC)
I $G(TOTAL)'="" W !,?72,$E(LIN,1,7),!,?70,$J(TOTAL,9,2) D CHKPG
I $G(TOTAL)=""!($G(TOTAL)=0) W !,?35,"*** NO RECORDS TO PRINT *** "
I $E(IOST)="P" W @IOF
EXIT K SRV,SRVNM,PRI,VTI,PRCNF,PRCNIT0,PRCNL,PRCNLDD,QTY,RQ,RDQ,SBTOT,TOTAL
K LIN,LL,NL,PG,PI,PRCNDAT0,RQD,COST,QTY,TRN,TXT,X,DN,C,PRCNC,I,Y,Z
K DIW,DIWF,DIWI,DIWL,DIWR,DIWT,DIWTC,DIWX
D ^%ZISC
Q
CHKPG ; If printing to screen & it is full, clear screen, if printing to
; a printer take appropriate action
Q:$G(PRCNC)'=""
Q:IOSL>(NL+6)
I $E(IOST)="C" W !,"Press RETURN to continue or '^' to quit. " R PRCNC:DTIME S:'$T PRCNC=U K:PRCNC'?1"^".E PRCNC Q:$G(PRCNC)'=""
D HDR
Q
HDR ; Print a header for the report
U IO S PG=PG+1,$P(TXT," ",40)="" W @IOF
W !,"REQUESTS BY SERVICE PRIORITY"
W $J("",IOM-$L(TXT)\2) S X="N",%DT="T" D ^%DT
W $$FMTE^XLFDT(Y,"1P")_" PAGE: "_PG,!
W !,"TRANSACTION #",?20,"PRIORITY",?40,"TYPE",?54,"COST",?62,"QUANTITY",?73,"TOTAL"
W !,?39,"PARENT SYSTEM",!,?5,"ITEM DESCRIPTION",?39,"/ COMPONENT"
W !,?40,"JUSTIFICATION",!,LIN,!
W !,"SERVICE: ",SRVNM,!
S NL=10
Q
ITD ; Get item description and format
K ^UTILITY($J,"W") S DIWR=27,DIWL=1,DIWF=""
S RQD=0 F S RQD=$O(^PRCN(413,TRN,1,RQ,1,RQD)) Q:RQD'>0 S X=^PRCN(413,TRN,1,RQ,1,RQD,0) D ^DIWP
I $G(^UTILITY($J,"W",DIWL))="" Q
F PI=1:1:^UTILITY($J,"W",DIWL) S NL=NL+1 D CHKPG Q:$G(PRCNC)'="" W !,?5,^UTILITY($J,"W",DIWL,PI,0) I PI=1 D
. W ?38,$E(PRCNF,1,12),?54,$J(COST,6,2),?62,$J(QTY,4,0),?73,$J(SBTOT,6,2)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRCNSERP 3497 printed Dec 13, 2024@01:54:38 Page 2
PRCNSERP ;SSI/ALA-Service Priority Report ;[ 02/04/97 6:44 PM ]
+1 ;;1.0;PRCN;**3,7**;Sep 13, 1996
EN ; Begin report by selecting a service
+1 SET DIR(0)="SM^O:Select One Service;A:Select All Services"
SET DIR("A")="Select Print Type "
+2 DO ^DIR
KILL DIR
SET VTI=$TRANSLATE(X,"ao","AO")
IF VTI["^"
GOTO EXIT
+3 IF VTI="O"
DO SRV
if $GET(SRV)=""
GOTO EXIT
+4 SET $PIECE(LIN,"-",80)=""
SET PG=0
+5 SET %ZIS="MQ"
DO ^%ZIS
if POP>0
GOTO EXIT
+6 IF $DATA(IO("Q"))
Begin DoDot:1
+7 SET ZTRTN="BEG^PRCNSERP"
SET ZTDESC="Service Priority Report"
+8 SET ZTSAVE("VTI")=""
SET ZTSAVE("LIN")=""
SET ZTSAVE("PG")=""
SET ZTSAVE("SRVNM")=""
+9 IF $GET(SRV)'=""
SET ZTSAVE("SRV")=""
+10 DO ^%ZTLOAD
DO HOME^%ZIS
KILL IO("Q"),ZTSK,%ZTLOAD,ZTREQ
End DoDot:1
GOTO EXIT
+11 IF $EXTRACT(IOST)="P"
USE IO
BEG IF VTI="O"
SET PRI=""
SET TOTAL=0
DO HDR
GOTO PRI
+1 SET SRV=""
ALL SET SRV=$ORDER(^PRCN(413,"P",SRV))
IF SRV=""
DO CONT
GOTO EXIT
+1 SET PRI=""
SET TOTAL=0
SET SRVNM=$PIECE(^DIC(49,SRV,0),U)
Begin DoDot:1
+2 IF $EXTRACT(IOST)'="P"
IF PG>0
Begin DoDot:2
+3 READ !,"Press RETURN to continue or '^' to quit. ",PRCNC:DTIME
if '$TEST
SET PRCNC=U
+4 if PRCNC'?1"^".E
KILL PRCNC
End DoDot:2
if $GET(PRCNC)'=""
QUIT
+5 DO HDR
End DoDot:1
if $GET(PRCNC)'=""
QUIT
PRI SET PRI=$ORDER(^PRCN(413,"P",SRV,PRI))
+1 IF PRI=""
if VTI'="O"
GOTO ALL
IF VTI="O"
DO CONT
GOTO EXIT
+2 SET TRN=""
TRN SET TRN=$ORDER(^PRCN(413,"P",SRV,PRI,TRN))
if TRN=""
GOTO PRI
+1 SET PRCNDAT0=$GET(^PRCN(413,TRN,0))
IF PRCNDAT0=""
KILL ^PRCN(413,"P",SRV,PRI,TRN)
GOTO TRN
+2 SET PRCNL=$PIECE(PRCNDAT0,U,9)
SET PRCNLDD=$PIECE(^DD(413,8,0),U,3)
+3 SET PRCNF=""
FOR LL=1:1
if $PIECE(PRCNLDD,";",LL)=""
QUIT
IF $PIECE(PRCNLDD,";",LL)[PRCNL_":"
SET PRCNF=$PIECE($PIECE(PRCNLDD,";",LL),":",2)
QUIT
+4 IF $GET(PRCNC)'=""
DO EXIT
QUIT
+5 WRITE !,$PIECE(PRCNDAT0,U),?20,PRI,?40,$EXTRACT(PRCNF,1,8)
+6 SET NL=NL+1
DO CHKPG
if $GET(PRCNC)'=""
GOTO EXIT
+7 SET RQ=0
FOR
SET RQ=$ORDER(^PRCN(413,TRN,1,RQ))
if RQ'>0
QUIT
Begin DoDot:1
+8 SET PRCNIT0=^PRCN(413,TRN,1,RQ,0)
SET COST=$PIECE(PRCNIT0,U,4)
SET QTY=$PIECE(PRCNIT0,U,5)
+9 SET SBTOT=COST*QTY
SET TOTAL=TOTAL+SBTOT
+10 SET PRCNL=$PIECE(PRCNDAT0,U,9)
SET PRCNLDD=$PIECE(^DD(413.015,8,0),U,3)
+11 SET PRCNF=""
FOR LL=1:1
if $PIECE(PRCNLDD,";",LL)=""
QUIT
IF $PIECE(PRCNLDD,";",LL)[PRCNL_":"
SET PRCNF=$PIECE($PIECE(PRCNLDD,";",LL),":",2)
QUIT
+12 DO ITD
End DoDot:1
+13 GOTO TRN
SRV SET DIC(0)="AEQZ"
SET DIC="^DIC(49,"
DO ^DIC
if +Y<0
QUIT
+1 SET SRV=+Y
SET SRVNM=$PIECE(Y,U,2)
KILL DIC,Y
+2 QUIT
CONT if $GET(PRCNC)
QUIT
+1 IF $GET(TOTAL)'=""
WRITE !,?72,$EXTRACT(LIN,1,7),!,?70,$JUSTIFY(TOTAL,9,2)
DO CHKPG
+2 IF $GET(TOTAL)=""!($GET(TOTAL)=0)
WRITE !,?35,"*** NO RECORDS TO PRINT *** "
+3 IF $EXTRACT(IOST)="P"
WRITE @IOF
EXIT KILL SRV,SRVNM,PRI,VTI,PRCNF,PRCNIT0,PRCNL,PRCNLDD,QTY,RQ,RDQ,SBTOT,TOTAL
+1 KILL LIN,LL,NL,PG,PI,PRCNDAT0,RQD,COST,QTY,TRN,TXT,X,DN,C,PRCNC,I,Y,Z
+2 KILL DIW,DIWF,DIWI,DIWL,DIWR,DIWT,DIWTC,DIWX
+3 DO ^%ZISC
+4 QUIT
CHKPG ; If printing to screen & it is full, clear screen, if printing to
+1 ; a printer take appropriate action
+2 if $GET(PRCNC)'=""
QUIT
+3 if IOSL>(NL+6)
QUIT
+4 IF $EXTRACT(IOST)="C"
WRITE !,"Press RETURN to continue or '^' to quit. "
READ PRCNC:DTIME
if '$TEST
SET PRCNC=U
if PRCNC'?1"^".E
KILL PRCNC
if $GET(PRCNC)'=""
QUIT
+5 DO HDR
+6 QUIT
HDR ; Print a header for the report
+1 USE IO
SET PG=PG+1
SET $PIECE(TXT," ",40)=""
WRITE @IOF
+2 WRITE !,"REQUESTS BY SERVICE PRIORITY"
+3 WRITE $JUSTIFY("",IOM-$LENGTH(TXT)\2)
SET X="N"
SET %DT="T"
DO ^%DT
+4 WRITE $$FMTE^XLFDT(Y,"1P")_" PAGE: "_PG,!
+5 WRITE !,"TRANSACTION #",?20,"PRIORITY",?40,"TYPE",?54,"COST",?62,"QUANTITY",?73,"TOTAL"
+6 WRITE !,?39,"PARENT SYSTEM",!,?5,"ITEM DESCRIPTION",?39,"/ COMPONENT"
+7 WRITE !,?40,"JUSTIFICATION",!,LIN,!
+8 WRITE !,"SERVICE: ",SRVNM,!
+9 SET NL=10
+10 QUIT
ITD ; Get item description and format
+1 KILL ^UTILITY($JOB,"W")
SET DIWR=27
SET DIWL=1
SET DIWF=""
+2 SET RQD=0
FOR
SET RQD=$ORDER(^PRCN(413,TRN,1,RQ,1,RQD))
if RQD'>0
QUIT
SET X=^PRCN(413,TRN,1,RQ,1,RQD,0)
DO ^DIWP
+3 IF $GET(^UTILITY($JOB,"W",DIWL))=""
QUIT
+4 FOR PI=1:1:^UTILITY($JOB,"W",DIWL)
SET NL=NL+1
DO CHKPG
if $GET(PRCNC)'=""
QUIT
WRITE !,?5,^UTILITY($JOB,"W",DIWL,PI,0)
IF PI=1
Begin DoDot:1
+5 WRITE ?38,$EXTRACT(PRCNF,1,12),?54,$JUSTIFY(COST,6,2),?62,$JUSTIFY(QTY,4,0),?73,$JUSTIFY(SBTOT,6,2)
End DoDot:1
+6 QUIT
