PRCNPROJ.m

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 ---PRCNPROJ   1104     printed  Apr 09, 2024@20:59:37                                                                                                                                                                                                    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