source: WorldVistAEHR/trunk/r/EQUIPMENT_TURN_IN_REQUEST-PRCN/PRCNPR2.m@ 691

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

initial load of WorldVistAEHR

File size: 1.5 KB
RevLine 
[613]1PRCNPR2 ;SSI/SEB-Print fields based on their type ;[ 08/05/96 12:53 PM ]
2 ;;1.0;Equipment/Turn-In Request;;Sep 13, 1996
3PR ; Print whatever
4 S PRCNDD=^DD(N,FN,0),ID=$P(PRCNDD,U,2),PC=$P(PRCNDD,U,4)
5 F I=1:1:PRCNDEEP W " "
6 W:ID'="W"&($P(^DD(N,0),U,4)>1) $P(PRCNDD,U),": " I ID["C" D COMP Q
7 Q:PC=""!(PC=" ")!(IN'?1N.N) I +ID D MULT Q
8 S VAL=$P($G(@(GLO_IN_","_$P(PC,";")_")")),U,$P(PC,";",2))
9 W:ID["W"!(ID["F")!(ID["N") VAL I ID["D"&(VAL]"") S Y=VAL D DD^%DT W Y
10 I ID["P" D
11 . I VAL=""!(VAL'?.N) W VAL Q
12 . I VAL?.N S PGL="^"_$P(PRCNDD,U,3),PV=$P($G(@(PGL_VAL_",0)")),U) W PV Q
13 I ID["S" S CODES=$P(PRCNDD,U,3) F I=1:1 S C=$P(CODES,";",I) Q:C="" W:VAL=$P(C,":") $P(C,":",2)
14 Q
15COMP ; Deal with computed fields
16 F I=0:1 S V=$P(GLO,",",2*(I+1)) Q:V="" X "S D"_I_"=V"
17 X "S D"_I_"=IN",$P(^DD(N,FN,0),U,5,99) W X F J=1:1:I X "K D"_I
18 Q
19MULT ; Deal with multiples and word-processing fields
20 N OFN S OFN=FN
21 S OPC=PC,OIN=IN,OID=ID,OGLO=GLO N FN,N,IN,PC,ID,GLO
22 S GLO=OGLO_OIN_","_$P(OPC,";")_",",N=+OID
23 S IN=0 F S IN=$O(@(GLO_IN_")")) Q:IN'?1N.N D
24 . S PRCNDEEP=PRCNDEEP+1 X "D SUBS^PRCN"_PROG S PRCNDEEP=PRCNDEEP-1
25 Q
26QUE ; When queuing off the display/print of request
27 S ZTRTN="BEG^PRCNPRNT",ZTDESC="Equipment Request"
28 S ZTSAVE("IN")="",ZTSAVE("PRCNUSR")="",ZTSAVE("PRCNTDA")=""
29 D ^%ZTLOAD,HOME^%ZIS K IO("Q"),ZTSK,%ZTLOAD,ZTREQ
30 Q
31QUT ; When queuing off the display/print of a turnin request
32 S ZTRTN="TN^PRCNPRNT",ZTSAVE("F")="",ZTSAVE("PRCNDEEP")=""
33 S ZTSAVE("N")="",ZTSAVE("GLO")="",ZTSAVE("FF")=""
34 D ^%ZTLOAD,HOME^%ZIS K IO("Q"),ZTSK,%ZTLOAD,ZTREQ
35 Q
Note: See TracBrowser for help on using the repository browser.