105 lines
4.6 KiB
Mathematica
105 lines
4.6 KiB
Mathematica
PRCNPRNT ;SSI/SEB-Display an NX transaction ;[ 01/30/97 1:30 PM ]
|
|
;;1.0;PRCN;**3**;Sep 13, 1996
|
|
;
|
|
; Needs IN to be set to internal # of transaction,
|
|
; PRCNUSR = user code: 0:requestor/CMR official, 1=PPM Committee I,
|
|
; 2=Engineering Committee, 3=PPM II, 4=Director, 5=Concurring Officials,
|
|
; 6=PPM III, 7=VACO Chief of Supply, 8=Equipment Committee.
|
|
;
|
|
S DIC("A")="Enter TRANSACTION #: ",DIC="^PRCN(413,",DIC(0)="AEQ" D ^DIC
|
|
S IN=+Y G EXIT:IN<0 S ST=$P(^PRCN(413,IN,0),U,7),PRCNTDA=$P(^(0),U,11)
|
|
S PRCNUSR=$S(ST<4:0,ST<7:1,ST=7!(ST=13):4,ST=8!(ST=11):2,ST=28:7,ST=15!(ST=32):6,ST=26!(ST=27)!(ST=30):3,ST=10!(ST=20)!(ST=29)!(ST=33):8,ST<15:5,1:3)
|
|
SETUP ; Set up necessary variables & open device
|
|
VIEWA W !!,"Do you want to view the information related to this request"
|
|
S %=1 D YN^DICN Q:%=2!(%<0)
|
|
I %=0 D G VIEWA
|
|
. W !,"Enter 'YES' if you want to see a display of the information related"
|
|
. W !,"to this request."
|
|
S %ZIS="Q" D ^%ZIS Q:POP
|
|
I $D(IO("Q")) D QUE^PRCNPR2 Q
|
|
Q:$D(DUOUT) I $E(IOST)="C" W @IOF
|
|
I $E(IOST)'="C" U IO
|
|
BEG S NL=0,FF=0,PRCNDEEP=0,N=413,GLO="^PRCN(413,",OFN=.01,PROG="PRNT"
|
|
FORMAT ; Deal with special field formatting
|
|
S F(413)="3^5^6^7^15^16^30^55^56^57^46",F(413.015)=".01^2^4^6"
|
|
S F(413.028)=.01,F(413.046)=1,F(6914)="1^4"
|
|
SUBS ; Handle subfields
|
|
G:PRCNDEEP=0 REQCMR I N=413.015 D Q
|
|
. F FN=.01,1,15,2:1:8 Q:$D(DUOUT) D PRFLD(FN)
|
|
. Q:$D(DUOUT) D:PRCNUSR>1 PRFLD(13)
|
|
. W !
|
|
I N=413.046 D Q
|
|
. S PNAME=$P(@(GLO_"IN,0)"),U),NAME=$P(^PRCN(413.3,PNAME,0),U)
|
|
. W !,?4,"NAME: ",$P(^VA(200,NAME,0),U),?45,"TITLE: "
|
|
. S TITLE=$P(^VA(200,NAME,0),U,9) W:TITLE]"" $P(^DIC(3.1,TITLE,0),U)
|
|
. F FN=1,2,4 Q:$D(DUOUT) D PRFLD(FN)
|
|
. S:$P($G(@(GLO_IN_",0)")),U,2)="N" QF=""
|
|
Q:$D(DUOUT) S FN=0
|
|
F S FN=$O(^DD(N,FN)) Q:FN="B"!($D(DUOUT)) D PRFLD(FN)
|
|
Q
|
|
TURNIN ; Print stuff for turn-in
|
|
S IN=$P(^PRCN(413.1,TDA,1,TI,0),U),PRCNTDA=TDA
|
|
TI2 S F(6914)="1^4",N=6914,GLO="^ENG(6914,",PRCNDEEP=1,FF=0
|
|
I '$D(IOST) D Q:POP>0
|
|
. S %ZIS="Q" D ^%ZIS
|
|
. I $D(IO("Q")) D QUT^PRCNPR2 Q
|
|
TN I $E(IOST)'="C" U IO
|
|
S FN=.01 D PRFLD(FN) Q:$D(DUOUT) S FF=0
|
|
F FN=3,1,4,5,17,18,12,13,19,16,24 D PRFLD(FN) Q:$D(DUOUT)
|
|
S F(413.11)=".5^.7^1",N=413.11,GLO="^PRCN(413.1,"_PRCNTDA_",1,",PRCNDEEP=1,FF=0
|
|
F FN=.5,.7,1 NEW IN S IN=TI D PRFLD(FN) Q:$D(DUOUT)
|
|
S IN=TDA,F(413.1)=16,N=413.1,GLO="^PRCN(413.1,",PRCNDEEP=1,FF=0
|
|
F FN=16 D PRFLD(FN) Q:$D(DUOUT)
|
|
W !
|
|
Q
|
|
REQCMR ; Print fields seen by requestor/CMR official review
|
|
F FN=.01,1:1:15 D PRFLD(FN) Q:$D(DUOUT)
|
|
I $P(^PRCN(413,IN,0),U,9)="R" S (PRCNTDA,TDA)=$P(^(0),U,11),TI=0 D
|
|
. W !!,"TURN-IN LINE ITEMS:" S NL=NL+1 D CHKPG Q:$D(DUOUT)
|
|
. S TMP=IN F S TI=$O(^PRCN(413.1,TDA,1,TI)) Q:TI'>0!($D(DUOUT)) D
|
|
.. W !,?4,"EQ. REQUEST LINE NUMBER: ",$P(^PRCN(413.1,TDA,1,TI,0),U,3)
|
|
.. D CHKPG,TURNIN:'$D(DUOUT)
|
|
. S N=413,GLO="^PRCN(413,",IN=TMP,PRCNDEEP=0 K TMP
|
|
Q:$D(DUOUT) F FN=126,16:1:31,100:1:104 D PRFLD(FN) Q:$D(DUOUT)
|
|
PPM ; Print fields seen by PPM 1 official review
|
|
G:PRCNUSR<1!($D(DUOUT)) EXIT
|
|
S FN2=$S($P($G(^PRCN(413,IN,2)),U,16)="N":105,1:34) S:FN2=105 QF=""
|
|
F FN=32,FN2 D PRFLD(FN) Q:$D(DUOUT)!($D(QF))
|
|
ENGIN ; Print fields seen by Engineering Committee
|
|
G:PRCNUSR<2!($D(DUOUT))!($D(QF)) EXIT
|
|
D PRFLD(35),PRFLD(121):$P($G(^PRCN(413,IN,4)),U)="N"
|
|
PPM2 ; Print fields seen by PPM 2 official review
|
|
G:PRCNUSR<3!($D(DUOUT))!($D(QF)) EXIT
|
|
F FN=52:1:72,74,117:1:120 D PRFLD(FN) Q:$D(DUOUT)
|
|
CONCUR ; Print fields seen by Concurring Official
|
|
G:PRCNUSR<5!($D(DUOUT))!($D(QF)) EXIT
|
|
PPM3 ; Print fields seen by PPM 3 official review
|
|
G:PRCNUSR<6!($D(DUOUT))!($D(QF)) EXIT
|
|
F FN=45,46,49 D PRFLD(FN) Q:$D(DUOUT)
|
|
CHIEF ; Print fields seen by VACO Chief of Supply
|
|
G:PRCNUSR<7!($D(DUOUT))!($D(QF)) EXIT S PRCNDATA=$G(^PRCN(413,IN,4))
|
|
F FN=36,37 D PRFLD(FN) Q:$D(DUOUT)
|
|
EQUIP ; Print fields seen by Equipment Committee
|
|
G:PRCNUSR<8!($D(DUOUT))!($D(QF)) EXIT
|
|
I $P($G(^PRCN(413,IN,8)),U,9)]"" F FN=77 D PRFLD(FN) Q:$D(DUOUT)
|
|
EXIT K DUOUT,QF I $E(IOST)'="C" W @IOF
|
|
K CODES,F,FF,FN,FN2,GLO,I,ID,J,N,N2,NEWL,NL,OFN,OGLO,OID,OIN,PNAME
|
|
K OPC,PC,PGL,PRCNDATA,PRCNDD,PRCNDEEP,PROG,PV,VAL,C,V,NAME
|
|
D ^%ZISC
|
|
Q
|
|
PRFLD(FN) ; Print a single field
|
|
I $$ISWP(FN) S FF=0 G PR2
|
|
G:'$D(F(N)) PR2 I F(N)="" S FF=0 G PR2
|
|
F I=1:1 S NEWL=$P(F(N),U,I) Q:NEWL=""!(NEWL=FN)
|
|
S:NEWL=FN!(PRCNDEEP>1) FF=0
|
|
PR2 D:'FF CHKPG Q:$D(DUOUT) X "W "_$S(FF:"?41",1:"!") S FF='FF
|
|
D PR^PRCNPR2 S:$$ISWP(FN) FF=0 Q
|
|
CHKPG ; Clear screen if it is full & start new one
|
|
I $G(C)=U Q
|
|
S NL=NL+1 Q:NL<(IOSL-4) I $E(IOST)'="C" W @IOF S NL=0 Q
|
|
F R !!,"Press RETURN to continue, or '^' to exit. ",C:DTIME S:'$T C=U Q:U[C W $C(7)
|
|
I C="^" S DUOUT="" Q
|
|
W @IOF S NL=0 Q
|
|
ISWP(FN) ; Check if field is word-processing or similar
|
|
S N2=$P(^DD(N,FN,0),U,2) Q:N2="W" 1 Q:+N2=0 0 Q ($P(^DD(+N2,0),U,4)=1)
|