PRCNHLP ;SSI/SEB-Help/lookup for NX ;[ 02/07/96 1:56 PM ]
;;1.0;Equipment/Turn-In Request;;Sep 13, 1996
A ; Executable help for Contract field of vendor file (440)
NEW I
S V=$S($D(DG("0;2")):DG("0;2"),1:$P(^PRCN(413,DA(1),1,DA,0),U,2)),I=0
Q:V="" W !,"Contracts on file for ",$P(^PRC(440,V,0),U),":"
F J=1:1 S I=$O(^PRC(440,V,4,I)) W:I>0 ! G:I'>0 EXIT D
. W:$P(^PRC(440,V,4,I,0),U,2)>DT !,$P(^PRC(440,V,4,I,0),U)
G EXIT
B ; Input transform for Contract field of vendor file (440)
NEW I
S V=$S($D(DG("0;2")):DG("0;2"),1:$P(^PRCN(413,DA(1),1,DA,0),U,2))
Q:V=""
S I=$O(^PRC(440,V,"B",4,X,""))
I I]"" K:$P(^PRC(440,V,4,I,0),U,3)'=V!($P(^PRC(440,V,4,I,0),U,2)'>DT) X
EXIT K I,J,V
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRCNHLP 709 printed Dec 13, 2024@01:54:21 Page 2
PRCNHLP ;SSI/SEB-Help/lookup for NX ;[ 02/07/96 1:56 PM ]
+1 ;;1.0;Equipment/Turn-In Request;;Sep 13, 1996
A ; Executable help for Contract field of vendor file (440)
+1 NEW I
+2 SET V=$SELECT($DATA(DG("0;2")):DG("0;2"),1:$PIECE(^PRCN(413,DA(1),1,DA,0),U,2))
SET I=0
+3 if V=""
QUIT
WRITE !,"Contracts on file for ",$PIECE(^PRC(440,V,0),U),":"
+4 FOR J=1:1
SET I=$ORDER(^PRC(440,V,4,I))
if I>0
WRITE !
if I'>0
GOTO EXIT
Begin DoDot:1
+5 if $PIECE(^PRC(440,V,4,I,0),U,2)>DT
WRITE !,$PIECE(^PRC(440,V,4,I,0),U)
End DoDot:1
+6 GOTO EXIT
B ; Input transform for Contract field of vendor file (440)
+1 NEW I
+2 SET V=$SELECT($DATA(DG("0;2")):DG("0;2"),1:$PIECE(^PRCN(413,DA(1),1,DA,0),U,2))
+3 if V=""
QUIT
+4 SET I=$ORDER(^PRC(440,V,"B",4,X,""))
+5 IF I]""
if $PIECE(^PRC(440,V,4,I,0),U,3)'=V!($PIECE(^PRC(440,V,4,I,0),U,2)'>DT)
KILL X
EXIT KILL I,J,V
+1 QUIT
