- 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 Mar 13, 2025@20:59:08 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
