- PRCNTIRQ ;SSI/ALA-Enter a Turn-In Request ;[ 02/06/97 11:57 AM ]
- ;;1.0;Equipment/Turn-In Request;**2**;Sep 13, 1996
- EN D NOW^%DTC S PRCNDTM=% K %I,%H
- D FYQ^PRCNUTL S PRCF("X")="S" D ^PRCFSITE G EXIT:'$D(PRC("SITE"))
- S DIC(0)="AEQZ",DIC="^ENG(6914.1," D ^DIC G EXIT:Y<1
- S PRCN("CMR")=$P(Y(0),U),PRCNCMR=+Y,PRCNSRV=$P(Y(0),U,5)
- I PRCNSRV="" D G EXIT:Y<1
- . S DIC="^DIC(49," D ^DIC S PRCNSRV=+Y
- K DIC,Y
- ENR ; Get the next sequential number
- I $G(PRC("SITE"))="" S PRC("SITE")=$P($P(^PRCN(413,DA,0),U),"-")
- I $G(PRCN("CMR"))="" S PRCN("CMR")=$P($P(^PRCN(413,DA,0),U),"-",2)
- I $G(PRC("FY"))="" S PRC("FY")=$P($P(^PRCN(413,DA,0),U),"-",3)
- S TST=PRC("SITE")_"-"_PRCN("CMR")_"-"_PRC("FY") D SEQ^PRCNUTL
- S PRCNRTN=TST_"-"_$E("00000",$L(PRCNDA)+1,5)_PRCNDA
- ; File into temporary transaction file
- N DA,DIC,DIE,Y
- S DIC="^PRCN(413.1,",DIC(0)="L",DLAYGO=413.1,X=PRCNRTN D FILE^DICN
- S PRCNTDA=DA I $G(PRCNTY)'="" D
- . S ^PRCN(413.1,PRCNTDA,0)=PRCNRTN_U_$P(^PRCN(413,PRCNRDA,0),U,2,8)
- . S $P(^PRCN(413.1,PRCNTDA,0),U,9)=PRCNRDA,$P(^PRCN(413,PRCNRDA,0),U,11)=PRCNTDA
- . S $P(^PRCN(413.1,PRCNTDA,0),U,16)=$P(^PRCN(413,PRCNRDA,0),U,16)
- G EXIT:$D(PRCNTY)
- TIN ; Select a Turn-In request, display info & get justification
- W !!,"This request has been assigned transaction #: ",PRCNRTN,!
- S PRCNFA=0,DIE=413.1,DA=PRCNTDA,DR="[PRCNTIRQ]"
- S EDIT=$S($P(^PRCN(413.1,PRCNTDA,0),U,7)="":0,1:1) D ^DIE
- EXIT K PRC,PRCF,PRCN,PRCNDA,DIC,DIE
- K %DT,EDIT,TST,X,RI,%,DA,DLAYGO,PRCNFA,PRCNFAP
- I $G(PRCNTY)="" K PRCNRTN
- Q
- DISP ; Display line item info
- NEW DIC,DA,DR,DI
- S DA=RI,DIC=6914,DR=".01;3;2;4;5;12;18;19;24",DIQ(0)="E",DIQ="PRCNDAT"
- D EN^DIQ1
- W !,"CSN: ",$G(PRCNDAT(6914,RI,18,"E"))
- W !,"Description: ",$G(PRCNDAT(6914,RI,3,"E"))
- W !,"Model #: ",$G(PRCNDAT(6914,RI,4,"E"))
- W ?40,"Serial #: ",$G(PRCNDAT(6914,RI,5,"E"))
- W !,"Manufacturer: ",$G(PRCNDAT(6914,RI,1,"E"))
- W ?40,"Last Location: ",$G(PRCNDAT(6914,RI,24,"E"))
- W !,"Aquisition Value: ","$ "_$G(PRCNDAT(6914,RI,12,"E"))
- W ?40,"CMR: ",$G(PRCNDAT(6914,RI,19,"E"))
- K PRCNDAT
- Q
- INP ; Input transform check for validity of selection
- I DR["PRCNTIPPM",'$D(^PRCN(413.1,D0,1,"B",X)) W !,$C(7)," Cannot add item to turn in at this point" K X Q
- I $G(PRCNFA)="" S PRCNFA=0
- I $G(PRCNCMR)="" S PRCNCMR=$P(^PRCN(413.1,DA,0),U,16)
- I $D(^PRCN(413.1,"AB",X)) W !,$C(7)," Request already on file for this item" K X Q
- ;S ACQ=$P($G(^ENG(6914,X,3)),U,4) I ACQ'="P"&(ACQ'="M")&(ACQ'="O")&(ACQ'="") K X W !,$C(7),"Item not owned by facility" Q
- I $P($G(^ENG(6914,X,2)),U,9)'=PRCNCMR W !,$C(7)," Item not in this CMR" K X Q
- S PRCNFAP=$$CHKFA^ENFAUTL(X)
- I 'PRCNFA,PRCNFAP S PRCNFA=1 Q
- I PRCNFA,'PRCNFAP W !,$C(7),"Previous item capitalized, this item isn't" K X Q
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRCNTIRQ 2769 printed Mar 13, 2025@20:59:25 Page 2
- PRCNTIRQ ;SSI/ALA-Enter a Turn-In Request ;[ 02/06/97 11:57 AM ]
- +1 ;;1.0;Equipment/Turn-In Request;**2**;Sep 13, 1996
- EN DO NOW^%DTC
- SET PRCNDTM=%
- KILL %I,%H
- +1 DO FYQ^PRCNUTL
- SET PRCF("X")="S"
- DO ^PRCFSITE
- if '$DATA(PRC("SITE"))
- GOTO EXIT
- +2 SET DIC(0)="AEQZ"
- SET DIC="^ENG(6914.1,"
- DO ^DIC
- if Y<1
- GOTO EXIT
- +3 SET PRCN("CMR")=$PIECE(Y(0),U)
- SET PRCNCMR=+Y
- SET PRCNSRV=$PIECE(Y(0),U,5)
- +4 IF PRCNSRV=""
- Begin DoDot:1
- +5 SET DIC="^DIC(49,"
- DO ^DIC
- SET PRCNSRV=+Y
- End DoDot:1
- if Y<1
- GOTO EXIT
- +6 KILL DIC,Y
- ENR ; Get the next sequential number
- +1 IF $GET(PRC("SITE"))=""
- SET PRC("SITE")=$PIECE($PIECE(^PRCN(413,DA,0),U),"-")
- +2 IF $GET(PRCN("CMR"))=""
- SET PRCN("CMR")=$PIECE($PIECE(^PRCN(413,DA,0),U),"-",2)
- +3 IF $GET(PRC("FY"))=""
- SET PRC("FY")=$PIECE($PIECE(^PRCN(413,DA,0),U),"-",3)
- +4 SET TST=PRC("SITE")_"-"_PRCN("CMR")_"-"_PRC("FY")
- DO SEQ^PRCNUTL
- +5 SET PRCNRTN=TST_"-"_$EXTRACT("00000",$LENGTH(PRCNDA)+1,5)_PRCNDA
- +6 ; File into temporary transaction file
- +7 NEW DA,DIC,DIE,Y
- +8 SET DIC="^PRCN(413.1,"
- SET DIC(0)="L"
- SET DLAYGO=413.1
- SET X=PRCNRTN
- DO FILE^DICN
- +9 SET PRCNTDA=DA
- IF $GET(PRCNTY)'=""
- Begin DoDot:1
- +10 SET ^PRCN(413.1,PRCNTDA,0)=PRCNRTN_U_$PIECE(^PRCN(413,PRCNRDA,0),U,2,8)
- +11 SET $PIECE(^PRCN(413.1,PRCNTDA,0),U,9)=PRCNRDA
- SET $PIECE(^PRCN(413,PRCNRDA,0),U,11)=PRCNTDA
- +12 SET $PIECE(^PRCN(413.1,PRCNTDA,0),U,16)=$PIECE(^PRCN(413,PRCNRDA,0),U,16)
- End DoDot:1
- +13 if $DATA(PRCNTY)
- GOTO EXIT
- TIN ; Select a Turn-In request, display info & get justification
- +1 WRITE !!,"This request has been assigned transaction #: ",PRCNRTN,!
- +2 SET PRCNFA=0
- SET DIE=413.1
- SET DA=PRCNTDA
- SET DR="[PRCNTIRQ]"
- +3 SET EDIT=$SELECT($PIECE(^PRCN(413.1,PRCNTDA,0),U,7)="":0,1:1)
- DO ^DIE
- EXIT KILL PRC,PRCF,PRCN,PRCNDA,DIC,DIE
- +1 KILL %DT,EDIT,TST,X,RI,%,DA,DLAYGO,PRCNFA,PRCNFAP
- +2 IF $GET(PRCNTY)=""
- KILL PRCNRTN
- +3 QUIT
- DISP ; Display line item info
- +1 NEW DIC,DA,DR,DI
- +2 SET DA=RI
- SET DIC=6914
- SET DR=".01;3;2;4;5;12;18;19;24"
- SET DIQ(0)="E"
- SET DIQ="PRCNDAT"
- +3 DO EN^DIQ1
- +4 WRITE !,"CSN: ",$GET(PRCNDAT(6914,RI,18,"E"))
- +5 WRITE !,"Description: ",$GET(PRCNDAT(6914,RI,3,"E"))
- +6 WRITE !,"Model #: ",$GET(PRCNDAT(6914,RI,4,"E"))
- +7 WRITE ?40,"Serial #: ",$GET(PRCNDAT(6914,RI,5,"E"))
- +8 WRITE !,"Manufacturer: ",$GET(PRCNDAT(6914,RI,1,"E"))
- +9 WRITE ?40,"Last Location: ",$GET(PRCNDAT(6914,RI,24,"E"))
- +10 WRITE !,"Aquisition Value: ","$ "_$GET(PRCNDAT(6914,RI,12,"E"))
- +11 WRITE ?40,"CMR: ",$GET(PRCNDAT(6914,RI,19,"E"))
- +12 KILL PRCNDAT
- +13 QUIT
- INP ; Input transform check for validity of selection
- +1 IF DR["PRCNTIPPM"
- IF '$DATA(^PRCN(413.1,D0,1,"B",X))
- WRITE !,$CHAR(7)," Cannot add item to turn in at this point"
- KILL X
- QUIT
- +2 IF $GET(PRCNFA)=""
- SET PRCNFA=0
- +3 IF $GET(PRCNCMR)=""
- SET PRCNCMR=$PIECE(^PRCN(413.1,DA,0),U,16)
- +4 IF $DATA(^PRCN(413.1,"AB",X))
- WRITE !,$CHAR(7)," Request already on file for this item"
- KILL X
- QUIT
- +5 ;S ACQ=$P($G(^ENG(6914,X,3)),U,4) I ACQ'="P"&(ACQ'="M")&(ACQ'="O")&(ACQ'="") K X W !,$C(7),"Item not owned by facility" Q
- +6 IF $PIECE($GET(^ENG(6914,X,2)),U,9)'=PRCNCMR
- WRITE !,$CHAR(7)," Item not in this CMR"
- KILL X
- QUIT
- +7 SET PRCNFAP=$$CHKFA^ENFAUTL(X)
- +8 IF 'PRCNFA
- IF PRCNFAP
- SET PRCNFA=1
- QUIT
- +9 IF PRCNFA
- IF 'PRCNFAP
- WRITE !,$CHAR(7),"Previous item capitalized, this item isn't"
- KILL X
- QUIT
- +10 QUIT
