PRCNPROJ ;SSI/ALA-Special Project Help Program ;[ 03/18/96 11:31 AM ]
;;1.0;Equipment/Turn-In Request;;Sep 13, 1996
LKUP ; Special help for Projects
W !,"Must begin with station number. Enter '??' for more help text."
W !!,"Projects currently in the Project File:"
S DUOUT=0,PRCNCT=0,PL=""
F S PL=$O(^ENG("PROJ","B",PL)) Q:PL="" D I $G(DUOUT)=1 S DUOUT=0 Q
. S L=$O(^ENG("PROJ","B",PL,""))
. S PRCNPJT=$P(^ENG("PROJ",L,0),U,3)
. S LL=PL_" "_PRCNPJT
. D T I $G(DUOUT)=1 Q
K L,PRCNA,PRCNCT
Q
INP ; Input transform check
I X'?3N1"-"3N&(X'?3N1"-"2NA1"-"3N) K X Q
S PRJNM=$O(^ENG("PROJ","B",X,"")) I PRJNM="" K PRJNM Q
S PRJMR=$P($G(^ENG("PROJ",PRJNM,33)),U,2)
I PRJMR'="",PRJMR?.N S PRJMR=$P(^VA(200,PRJMR,0),U)
Q
PROJ ; Make a request number into a project number
S (R,R2)=$P(^PRCN(413,D0,0),U) G EX:R["P" S $P(R2,"-",4)="P"_$P(R2,"-",4)
K ^PRCN(413,"B",R) S ^PRCN(413,"B",R2,D0)="",$P(^PRCN(413,D0,0),U)=R2
EX K R,R2
Q
T S PRCNCT=PRCNCT+1
I PRCNCT<10 W !,LL Q
R !,"'^' TO STOP: ",PRCNA:DTIME S:'$T PRCNA=U
I $G(PRCNA)[U S DUOUT=1 Q
S PRCNCT=0 Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRCNPROJ 1104 printed Nov 22, 2024@17:04:41 Page 2
PRCNPROJ ;SSI/ALA-Special Project Help Program ;[ 03/18/96 11:31 AM ]
+1 ;;1.0;Equipment/Turn-In Request;;Sep 13, 1996
LKUP ; Special help for Projects
+1 WRITE !,"Must begin with station number. Enter '??' for more help text."
+2 WRITE !!,"Projects currently in the Project File:"
+3 SET DUOUT=0
SET PRCNCT=0
SET PL=""
+4 FOR
SET PL=$ORDER(^ENG("PROJ","B",PL))
if PL=""
QUIT
Begin DoDot:1
+5 SET L=$ORDER(^ENG("PROJ","B",PL,""))
+6 SET PRCNPJT=$PIECE(^ENG("PROJ",L,0),U,3)
+7 SET LL=PL_" "_PRCNPJT
+8 DO T
IF $GET(DUOUT)=1
QUIT
End DoDot:1
IF $GET(DUOUT)=1
SET DUOUT=0
QUIT
+9 KILL L,PRCNA,PRCNCT
+10 QUIT
INP ; Input transform check
+1 IF X'?3N1"-"3N&(X'?3N1"-"2NA1"-"3N)
KILL X
QUIT
+2 SET PRJNM=$ORDER(^ENG("PROJ","B",X,""))
IF PRJNM=""
KILL PRJNM
QUIT
+3 SET PRJMR=$PIECE($GET(^ENG("PROJ",PRJNM,33)),U,2)
+4 IF PRJMR'=""
IF PRJMR?.N
SET PRJMR=$PIECE(^VA(200,PRJMR,0),U)
+5 QUIT
PROJ ; Make a request number into a project number
+1 SET (R,R2)=$PIECE(^PRCN(413,D0,0),U)
if R["P"
GOTO EX
SET $PIECE(R2,"-",4)="P"_$PIECE(R2,"-",4)
+2 KILL ^PRCN(413,"B",R)
SET ^PRCN(413,"B",R2,D0)=""
SET $PIECE(^PRCN(413,D0,0),U)=R2
EX KILL R,R2
+1 QUIT
T SET PRCNCT=PRCNCT+1
+1 IF PRCNCT<10
WRITE !,LL
QUIT
+2 READ !,"'^' TO STOP: ",PRCNA:DTIME
if '$TEST
SET PRCNA=U
+3 IF $GET(PRCNA)[U
SET DUOUT=1
QUIT
+4 SET PRCNCT=0
QUIT
