source: FOIAVistA/trunk/r/EQUIPMENT_TURN_IN_REQUEST-PRCN/PRCNTIPR.m@ 1607

Last change on this file since 1607 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 2.5 KB
Line 
1PRCNTIPR ;SSI/SEB-Display a NX Turn-in request ;[ 02/18/97 4:12 PM ]
2 ;;1.0;PRCN;**2,3**;Sep 13, 1996
3EN 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
5SETUP ; 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
12BEG S NL=0,FF=0,PRCNDEEP=0,N=413.1,GLO="^PRCN(413.1,",PROG="TIPR",OFN=.01
13FORMAT ; Deal with special field formatting
14 S F(413.1)="2^3^5^6^7^20"
15REQCMR ; 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
30PPM ; Print field seen by PPM
31EXIT 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
37SUBS ; 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
43PRFLD(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
48PR2 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
50PQ K NEWL,C Q
51CHKPG ; 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
56ISWP(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)
Note: See TracBrowser for help on using the repository browser.