PRCNPR2 ;SSI/SEB-Print fields based on their type ;[ 08/05/96 12:53 PM ]
;;1.0;Equipment/Turn-In Request;;Sep 13, 1996
PR ; Print whatever
S PRCNDD=^DD(N,FN,0),ID=$P(PRCNDD,U,2),PC=$P(PRCNDD,U,4)
F I=1:1:PRCNDEEP W " "
W:ID'="W"&($P(^DD(N,0),U,4)>1) $P(PRCNDD,U),": " I ID["C" D COMP Q
Q:PC=""!(PC=" ")!(IN'?1N.N) I +ID D MULT Q
S VAL=$P($G(@(GLO_IN_","_$P(PC,";")_")")),U,$P(PC,";",2))
W:ID["W"!(ID["F")!(ID["N") VAL I ID["D"&(VAL]"") S Y=VAL D DD^%DT W Y
I ID["P" D
. I VAL=""!(VAL'?.N) W VAL Q
. I VAL?.N S PGL="^"_$P(PRCNDD,U,3),PV=$P($G(@(PGL_VAL_",0)")),U) W PV Q
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)
Q
COMP ; Deal with computed fields
F I=0:1 S V=$P(GLO,",",2*(I+1)) Q:V="" X "S D"_I_"=V"
X "S D"_I_"=IN",$P(^DD(N,FN,0),U,5,99) W X F J=1:1:I X "K D"_I
Q
MULT ; Deal with multiples and word-processing fields
N OFN S OFN=FN
S OPC=PC,OIN=IN,OID=ID,OGLO=GLO N FN,N,IN,PC,ID,GLO
S GLO=OGLO_OIN_","_$P(OPC,";")_",",N=+OID
S IN=0 F S IN=$O(@(GLO_IN_")")) Q:IN'?1N.N D
. S PRCNDEEP=PRCNDEEP+1 X "D SUBS^PRCN"_PROG S PRCNDEEP=PRCNDEEP-1
Q
QUE ; When queuing off the display/print of request
S ZTRTN="BEG^PRCNPRNT",ZTDESC="Equipment Request"
S ZTSAVE("IN")="",ZTSAVE("PRCNUSR")="",ZTSAVE("PRCNTDA")=""
D ^%ZTLOAD,HOME^%ZIS K IO("Q"),ZTSK,%ZTLOAD,ZTREQ
Q
QUT ; When queuing off the display/print of a turnin request
S ZTRTN="TN^PRCNPRNT",ZTSAVE("F")="",ZTSAVE("PRCNDEEP")=""
S ZTSAVE("N")="",ZTSAVE("GLO")="",ZTSAVE("FF")=""
D ^%ZTLOAD,HOME^%ZIS K IO("Q"),ZTSK,%ZTLOAD,ZTREQ
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRCNPR2 1607 printed Apr 09, 2024@20:59:51 Page 2
PRCNPR2 ;SSI/SEB-Print fields based on their type ;[ 08/05/96 12:53 PM ]
+1 ;;1.0;Equipment/Turn-In Request;;Sep 13, 1996
PR ; Print whatever
+1 SET PRCNDD=^DD(N,FN,0)
SET ID=$PIECE(PRCNDD,U,2)
SET PC=$PIECE(PRCNDD,U,4)
+2 FOR I=1:1:PRCNDEEP
WRITE " "
+3 if ID'="W"&($PIECE(^DD(N,0),U,4)>1)
WRITE $PIECE(PRCNDD,U),": "
IF ID["C"
DO COMP
QUIT
+4 if PC=""!(PC=" ")!(IN'?1N.N)
QUIT
IF +ID
DO MULT
QUIT
+5 SET VAL=$PIECE($GET(@(GLO_IN_","_$PIECE(PC,";")_")")),U,$PIECE(PC,";",2))
+6 if ID["W"!(ID["F")!(ID["N")
WRITE VAL
IF ID["D"&(VAL]"")
SET Y=VAL
DO DD^%DT
WRITE Y
+7 IF ID["P"
Begin DoDot:1
+8 IF VAL=""!(VAL'?.N)
WRITE VAL
QUIT
+9 IF VAL?.N
SET PGL="^"_$PIECE(PRCNDD,U,3)
SET PV=$PIECE($GET(@(PGL_VAL_",0)")),U)
WRITE PV
QUIT
End DoDot:1
+10 IF ID["S"
SET CODES=$PIECE(PRCNDD,U,3)
FOR I=1:1
SET C=$PIECE(CODES,";",I)
if C=""
QUIT
if VAL=$PIECE(C,"
WRITE $PIECE(C,":",2)
+11 QUIT
COMP ; Deal with computed fields
+1 FOR I=0:1
SET V=$PIECE(GLO,",",2*(I+1))
if V=""
QUIT
XECUTE "S D"_I_"=V"
+2 XECUTE "S D"_I_"=IN"
XECUTE $PIECE(^DD(N,FN,0),U,5,99)
WRITE X
FOR J=1:1:I
XECUTE "K D"_I
+3 QUIT
MULT ; Deal with multiples and word-processing fields
+1 NEW OFN
SET OFN=FN
+2 SET OPC=PC
SET OIN=IN
SET OID=ID
SET OGLO=GLO
NEW FN,N,IN,PC,ID,GLO
+3 SET GLO=OGLO_OIN_","_$PIECE(OPC,";")_","
SET N=+OID
+4 SET IN=0
FOR
SET IN=$ORDER(@(GLO_IN_")"))
if IN'?1N.N
QUIT
Begin DoDot:1
+5 SET PRCNDEEP=PRCNDEEP+1
XECUTE "D SUBS^PRCN"_PROG
SET PRCNDEEP=PRCNDEEP-1
End DoDot:1
+6 QUIT
QUE ; When queuing off the display/print of request
+1 SET ZTRTN="BEG^PRCNPRNT"
SET ZTDESC="Equipment Request"
+2 SET ZTSAVE("IN")=""
SET ZTSAVE("PRCNUSR")=""
SET ZTSAVE("PRCNTDA")=""
+3 DO ^%ZTLOAD
DO HOME^%ZIS
KILL IO("Q"),ZTSK,%ZTLOAD,ZTREQ
+4 QUIT
QUT ; When queuing off the display/print of a turnin request
+1 SET ZTRTN="TN^PRCNPRNT"
SET ZTSAVE("F")=""
SET ZTSAVE("PRCNDEEP")=""
+2 SET ZTSAVE("N")=""
SET ZTSAVE("GLO")=""
SET ZTSAVE("FF")=""
+3 DO ^%ZTLOAD
DO HOME^%ZIS
KILL IO("Q"),ZTSK,%ZTLOAD,ZTREQ
+4 QUIT
