| [613] | 1 | PRCNTIPR ;SSI/SEB-Display a NX Turn-in request ;[ 02/18/97 4:12 PM ]
|
|---|
| 2 | ;;1.0;PRCN;**2,3**;Sep 13, 1996
|
|---|
| 3 | EN S DIC("A")="Select Turn-In TRANSACTION #: ",DIC="^PRCN(413.1,",DIC(0)="AEQ"
|
|---|
| 4 | D ^DIC G EXIT:Y<0 S (IN,PRCNTDA)=+Y,PRCNUSR=2
|
|---|
| 5 | SETUP ; Set up necessary variables & open device
|
|---|
| 6 | S %ZIS="Q" D ^%ZIS G EXIT:POP
|
|---|
| 7 | I $D(IO("Q")) D G EXIT
|
|---|
| 8 | . S ZTRTN="BEG^PRCNTIPR",ZTDESC="Equipment Request"
|
|---|
| 9 | . S ZTSAVE("IN")="",ZTSAVE("PRCNUSR")="",ZTSAVE("PRCNTDA")=""
|
|---|
| 10 | . D ^%ZTLOAD,HOME^%ZIS K IO("Q"),ZTSK,%ZTLOAD,ZTREQ
|
|---|
| 11 | G EXIT:$D(DUOUT) I $E(IOST)="C" W @IOF
|
|---|
| 12 | BEG S NL=0,FF=0,PRCNDEEP=0,N=413.1,GLO="^PRCN(413.1,",PROG="TIPR",OFN=.01
|
|---|
| 13 | FORMAT ; Deal with special field formatting
|
|---|
| 14 | S F(413.1)="2^3^5^6^7^20"
|
|---|
| 15 | REQCMR ; Print fields for requestor display or CMR Official review
|
|---|
| 16 | F FN=.01,1,2,3,4,5,6,7 D PRFLD(FN) Q:$D(DUOUT)
|
|---|
| 17 | I PRCNUSR>0!($G(ST)=4) F FN=9,11 D PRFLD(FN) Q:$D(DUOUT)
|
|---|
| 18 | G EXIT:$G(TIF)=1
|
|---|
| 19 | S TI=0 D
|
|---|
| 20 | . W !!,"TURN-IN LINE ITEMS:" S NL=NL+1 D CHKPG Q:$D(DUOUT)
|
|---|
| 21 | . F S TI=$O(^PRCN(413.1,PRCNTDA,1,TI)) Q:TI'>0!($D(DUOUT)) D
|
|---|
| 22 | .. W !!,?4,"EQ. REQUEST LINE NUMBER: ",$P(^PRCN(413.1,PRCNTDA,1,TI,0),U,3) S NL=NL+1
|
|---|
| 23 | .. S (IN,PRCNEIN)=$P(^PRCN(413.1,PRCNTDA,1,TI,0),U),TDA=PRCNTDA D TI2^PRCNPRNT
|
|---|
| 24 | .. Q:$D(DUOUT) S IN=PRCNTDA
|
|---|
| 25 | .. S PRCNTT=0,PRCNDT=0
|
|---|
| 26 | .. F S PRCNDT=$O(^ENG(6914,PRCNEIN,6,PRCNDT)) Q:'PRCNDT S PRCNXX=^(PRCNDT,0) D
|
|---|
| 27 | ... F PRCNJ=5:1:7 S PRCNTT=PRCNTT+$P(PRCNXX,U,PRCNJ)
|
|---|
| 28 | .. W !,"TOTAL REPAIR COSTS: ",PRCNTT S NL=NL+1
|
|---|
| 29 | .. D CHKPG
|
|---|
| 30 | PPM ; Print field seen by PPM
|
|---|
| 31 | EXIT K DUOUT,QF,DIC,NL,FF,PRCNDEEP,N,N2,GLO,PROG,OFN,F,TIL,FN,PRCNEIN
|
|---|
| 32 | K CODES,PRCNXX,PRCNTT,OIN,PC,PGL,PRCNDD,PRCNDT,PRCNJ
|
|---|
| 33 | K TDA,TI,NEWL,OGLO,OID,OPC,PV,I,ID,C
|
|---|
| 34 | I $E(IOST)'="C" W @IOF
|
|---|
| 35 | D ^%ZISC
|
|---|
| 36 | Q
|
|---|
| 37 | SUBS ; Handle subfields
|
|---|
| 38 | I N=413.11 S TIL=$P(@(GLO_"IN,0)"),U) W !,?4,"NUMBER: ",TIL,?41 D
|
|---|
| 39 | . W "DESCRIPTION: ",$P(^ENG(6914,TIL,0),U,2),!
|
|---|
| 40 | Q:N=413.11!($D(DUOUT)) S FN=0
|
|---|
| 41 | F S FN=$O(^DD(N,FN)) Q:FN="B"!($D(DUOUT)) D PRFLD(FN)
|
|---|
| 42 | Q
|
|---|
| 43 | PRFLD(FN) ; Print a single field
|
|---|
| 44 | I $$ISWP(FN) S FF=0 G PR2
|
|---|
| 45 | G:'$D(F(N)) PR2 I F(N)="" S FF=0 G PR2
|
|---|
| 46 | F I=1:1 S NEWL=$P(F(N),U,I) Q:NEWL=""!(NEWL=FN)
|
|---|
| 47 | S:NEWL=FN!(PRCNDEEP>1) FF=0
|
|---|
| 48 | PR2 D:'FF CHKPG G PQ:$D(DUOUT) X "W "_$S(FF:"?41",1:"!") S FF='FF
|
|---|
| 49 | D PR^PRCNPR2 S:$$ISWP(FN) FF=0
|
|---|
| 50 | PQ K NEWL,C Q
|
|---|
| 51 | CHKPG ; Clear screen if it is full & start new one
|
|---|
| 52 | S NL=NL+1 Q:NL<(IOSL-2) I $E(IOST)'="C" W @IOF S NL=0 Q
|
|---|
| 53 | F R !!,"Press RETURN to continue, or '^' to exit. ",C:DTIME S:'$T C=U Q:C[U W $C(7)
|
|---|
| 54 | I C="^" S DUOUT="" Q
|
|---|
| 55 | W @IOF S NL=0 Q
|
|---|
| 56 | ISWP(FN) ; Check if field is word-processing or similar
|
|---|
| 57 | 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)
|
|---|
