PRCSD12 ;WISC/SAW-CONTROL POINT ACT. 2237 TERMINAL DISPLAY ;2/13/13 12:59
V ;;5.1;IFCAP;**167,174**;Oct 20, 2000;Build 23
;Per VHA Directive 2004-38, this routine should not be modified.
S U="^",P(1)=0,Z1="" D NOW^%DTC S Y=% D DD^%DT W @IOF S L="",$P(L,"-",IOM)="-"
S P=$S($D(^PRCS(410,DA,1)):$P(^(1),U,3),1:""),P=$S(P="EM":"***EMERGENCY***",P="SP":"*SPECIAL*",1:"STANDARD") W ?26,"PRIORITY: ",P
W:$$ECMS2237^PRCHJUTL(DA) ?55,"Accepted by eCMS"
W !,Y,?31,$P(^PRCS(410,DA,0),U) W !,L
W !,?16,"REQUEST, TURN-IN, AND RECEIPT FOR PROPERTY OR SERVICES" W !,L
W !,"TO: A&MM Officer",?24,"Requesting Office"
W !,?24 S P=$P(^PRCS(410,DA,0),U,5),P1=$S($D(^(3)):+$P(^(3),U),1:"") I P,P1 S P=$S($D(^PRC(420,P,1,P1,0)):$P(^(0),U,10),1:"") I P,$D(^DIC(49,P,0)) W $P(^(0),U) W:$P(^(0),U,8)]"" " ("_$P(^(0),U,8)_")"
W !,$E(L,1,23)
W " ",$E(L,25,IOM)
W !,"Action Requested",?24,"Date Prepared",?46,"Date Required"
W !,?4,"Delivery",?24 I $D(^PRCS(410,DA,1)),$P(^(1),U)'="" S Y=$P(^(1),U) D DD^%DT W Y
W ?46 I $D(^PRCS(410,DA,1)),$P(^(1),U,4)'="" S Y=$P(^(1),U,4) D DD^%DT W Y
W !,$E(L,1,23)
W " ",$E(L,25,45)
W " ",$E(L,47,IOM)
W !,?2,"ITEM NO. ",?23,"DESCRIPTION",?52," QUANTITY UNIT ESTIMATED"
W !,"OR STOCK NO. ",?68,"UNIT COST",!,L
D ^PRCSD121 G EXIT:Z1=U D ^PRCSD122 G EXIT:Z1=U D ^PRCSD123 G EXIT:Z1=U W !,"Press return to continue: " R Z1:DTIME
EXIT K FPROJ,%DT,P,P1,PRCS("SUB"),X,X1,Y,Z,Z1,DIWL,DIWR,DIWF,I,J,K,^UTILITY($J,"W"),PRCSIN,PRCSQTY,PRCSDES,PRCSDS,PRCSDSD,PRCSILP,PRCSLNT,PRCSLN,N,PRCSPG Q
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRCSD12 1541 printed Oct 16, 2024@18:18:06 Page 2
PRCSD12 ;WISC/SAW-CONTROL POINT ACT. 2237 TERMINAL DISPLAY ;2/13/13 12:59
V ;;5.1;IFCAP;**167,174**;Oct 20, 2000;Build 23
+1 ;Per VHA Directive 2004-38, this routine should not be modified.
+2 SET U="^"
SET P(1)=0
SET Z1=""
DO NOW^%DTC
SET Y=%
DO DD^%DT
WRITE @IOF
SET L=""
SET $PIECE(L,"-",IOM)="-"
+3 SET P=$SELECT($DATA(^PRCS(410,DA,1)):$PIECE(^(1),U,3),1:"")
SET P=$SELECT(P="EM":"***EMERGENCY***",P="SP":"*SPECIAL*",1:"STANDARD")
WRITE ?26,"PRIORITY: ",P
+4 if $$ECMS2237^PRCHJUTL(DA)
WRITE ?55,"Accepted by eCMS"
+5 WRITE !,Y,?31,$PIECE(^PRCS(410,DA,0),U)
WRITE !,L
+6 WRITE !,?16,"REQUEST, TURN-IN, AND RECEIPT FOR PROPERTY OR SERVICES"
WRITE !,L
+7 WRITE !,"TO: A&MM Officer",?24,"Requesting Office"
+8 WRITE !,?24
SET P=$PIECE(^PRCS(410,DA,0),U,5)
SET P1=$SELECT($DATA(^(3)):+$PIECE(^(3),U),1:"")
IF P
IF P1
SET P=$SELECT($DATA(^PRC(420,P,1,P1,0)):$PIECE(^(0),U,10),1:"")
IF P
IF $DATA(^DIC(49,P,0))
WRITE $PIECE(^(0),U)
if $PIECE(^(0),U,8)]""
WRITE " ("_$PIECE(^(0),U,8)_")"
+9 WRITE !,$EXTRACT(L,1,23)
+10 WRITE " ",$EXTRACT(L,25,IOM)
+11 WRITE !,"Action Requested",?24,"Date Prepared",?46,"Date Required"
+12 WRITE !,?4,"Delivery",?24
IF $DATA(^PRCS(410,DA,1))
IF $PIECE(^(1),U)'=""
SET Y=$PIECE(^(1),U)
DO DD^%DT
WRITE Y
+13 WRITE ?46
IF $DATA(^PRCS(410,DA,1))
IF $PIECE(^(1),U,4)'=""
SET Y=$PIECE(^(1),U,4)
DO DD^%DT
WRITE Y
+14 WRITE !,$EXTRACT(L,1,23)
+15 WRITE " ",$EXTRACT(L,25,45)
+16 WRITE " ",$EXTRACT(L,47,IOM)
+17 WRITE !,?2,"ITEM NO. ",?23,"DESCRIPTION",?52," QUANTITY UNIT ESTIMATED"
+18 WRITE !,"OR STOCK NO. ",?68,"UNIT COST",!,L
+19 DO ^PRCSD121
if Z1=U
GOTO EXIT
DO ^PRCSD122
if Z1=U
GOTO EXIT
DO ^PRCSD123
if Z1=U
GOTO EXIT
WRITE !,"Press return to continue: "
READ Z1:DTIME
EXIT Press return to continue: KILL FPROJ,%DT,P,P1,PRCS("SUB"),X,X1,Y,Z,Z1,DIWL,DIWR,DIWF,I,J,K,^UTILITY($JOB,"W"),PRCSIN,PRCSQTY,PRCSDES,PRCSDS,PRCSDSD,PRCSILP,PRCSLNT,PRCSLN,N,PRCSPG
QUIT
+1 QUIT
