- PRCSP12 ;WISC/SAW-CONTROL POINT ACTIVITY 2237 PRINTOUT (FREE FORM) ;2/13/13 13:04
- V ;;5.1;IFCAP;**167,174**;Oct 20, 2000;Build 23
- ;Per VHA Directive 2004-38, this routine should not be modified.
- H 2 G P
- QUE I $D(ZTQUEUED) S DA=D0
- S DA=D0
- P U IO W:$Y>0 @IOF S U="^",P(1)=0,PRCS("P")=1,L="",$P(L,"_",90)="_" D NOW^%DTC S Y=% D DD^%DT
- S P=$S($D(^PRCS(410,DA,1)):$P(^(1),U,3),1:""),P=$S(P="EM":"***EMERGENCY***",P="SP":"*SPECIAL*",1:"STANDARD") W ?36,"PRIORITY: ",P
- W:$$ECMS2237^PRCHJUTL(DA) ?64,"Accepted by eCMS"
- W !,Y,?36,$P(^PRCS(410,DA,0),U),?83,"PAGE ",PRCS("P"),!,L
- W !,?16,"REQUEST, TURN-IN, AND RECEIPT FOR PROPERTY OR SERVICES",! I $D(ZTSAVE("NOPRINT")) W ?37,"**REPRINT**",!
- W !,L
- W !,"TO: A&MM Officer",?23,"|Requesting Office",?63,"|TO BE COMPLETED BY"
- W !,?23,"|" 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 ?63,"|SUPPLY PERSONNEL",!,$E(L,1,23)
- W "|",$E(L,1,39)
- W "|(NOTE - Alterations in"
- W !,"Action Requested",?23,"|Date Prepared",?45,"|Date Required",?63,"|""Action"" column will be"
- W !,?4,"Delivery",?23,"|" I $D(^PRCS(410,DA,1)),$P(^(1),U)'="" S Y=$P(^(1),U) D DD^%DT W Y
- W ?45,"|" I $D(^PRCS(410,DA,1)),$P(^(1),U,4)'="" S Y=$P(^(1),U,4) D DD^%DT W Y
- W ?63,"|initialed and dated)",!,$E(L,1,23)
- W "|",$E(L,1,21)
- W "|",$E(L,1,17)
- W "|",$E(L,1,26)
- W !,?2,"ITEM NO. |",?23,"DESCRIPTION",?38,"|QUANTITY |UNIT|ESTIMATED|UNIT COST|TOTAL COST|ACT."
- W !,"OR STOCK NO.|",?38,"|",?48,"|",?53,"|UNIT COST|",?73,"|",?84,"|NOTE1",!,$E(L,1,12),"|",$E(L,1,25),"|",$E(L,1,9),"|",$E(L,1,4),"|",$E(L,1,9),"|",$E(L,1,9),"|",$E(L,1,10),"|",$E(L,1,5)
- S:'$D(PRNTALL) PRNTALL=1
- D ^PRCSP121,^PRCSP122 W:PRNTALL=0 !,"VA FORM 90-2237-ADP MAR 1985",! D:PRNTALL=1 ^PRCSP123 I '$D(PRCHQ("DEST")) D ^PRCSP124 G EXIT
- I $D(PRCHQ("DEST")),PRCHQ("DEST")'="F" D ^PRCSP124
- EXIT K FPROJ,%DT,P,PRNTALL,X,X1,Y,Z,Z1,DA,DIWL,DIWR,DIWF,I,J,K,L,PRCS,^UTILITY($J,"W") D:$D(ZTSK) KILL^%ZTLOAD Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRCSP12 2073 printed Feb 18, 2025@23:44:18 Page 2
- PRCSP12 ;WISC/SAW-CONTROL POINT ACTIVITY 2237 PRINTOUT (FREE FORM) ;2/13/13 13:04
- V ;;5.1;IFCAP;**167,174**;Oct 20, 2000;Build 23
- +1 ;Per VHA Directive 2004-38, this routine should not be modified.
- +2 HANG 2
- GOTO P
- QUE IF $DATA(ZTQUEUED)
- SET DA=D0
- +1 SET DA=D0
- P USE IO
- if $Y>0
- WRITE @IOF
- SET U="^"
- SET P(1)=0
- SET PRCS("P")=1
- SET L=""
- SET $PIECE(L,"_",90)="_"
- DO NOW^%DTC
- SET Y=%
- DO DD^%DT
- +1 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 ?36,"PRIORITY: ",P
- +2 if $$ECMS2237^PRCHJUTL(DA)
- WRITE ?64,"Accepted by eCMS"
- +3 WRITE !,Y,?36,$PIECE(^PRCS(410,DA,0),U),?83,"PAGE ",PRCS("P"),!,L
- +4 WRITE !,?16,"REQUEST, TURN-IN, AND RECEIPT FOR PROPERTY OR SERVICES",!
- IF $DATA(ZTSAVE("NOPRINT"))
- WRITE ?37,"**REPRINT**",!
- +5 WRITE !,L
- +6 WRITE !,"TO: A&MM Officer",?23,"|Requesting Office",?63,"|TO BE COMPLETED BY"
- +7 WRITE !,?23,"|"
- 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)_")"
- +8 WRITE ?63,"|SUPPLY PERSONNEL",!,$EXTRACT(L,1,23)
- +9 WRITE "|",$EXTRACT(L,1,39)
- +10 WRITE "|(NOTE - Alterations in"
- +11 WRITE !,"Action Requested",?23,"|Date Prepared",?45,"|Date Required",?63,"|""Action"" column will be"
- +12 WRITE !,?4,"Delivery",?23,"|"
- IF $DATA(^PRCS(410,DA,1))
- IF $PIECE(^(1),U)'=""
- SET Y=$PIECE(^(1),U)
- DO DD^%DT
- WRITE Y
- +13 WRITE ?45,"|"
- IF $DATA(^PRCS(410,DA,1))
- IF $PIECE(^(1),U,4)'=""
- SET Y=$PIECE(^(1),U,4)
- DO DD^%DT
- WRITE Y
- +14 WRITE ?63,"|initialed and dated)",!,$EXTRACT(L,1,23)
- +15 WRITE "|",$EXTRACT(L,1,21)
- +16 WRITE "|",$EXTRACT(L,1,17)
- +17 WRITE "|",$EXTRACT(L,1,26)
- +18 WRITE !,?2,"ITEM NO. |",?23,"DESCRIPTION",?38,"|QUANTITY |UNIT|ESTIMATED|UNIT COST|TOTAL COST|ACT."
- +19 WRITE !,"OR STOCK NO.|",?38,"|",?48,"|",?53,"|UNIT COST|",?73,"|",?84,"|NOTE1",!,$EXTRACT(L,1,12),"|",$EXTRACT(L,1,25),"|",$EXTRACT(L,1,9),"|",$EXTRACT(L,1,4),"|",$EXTRACT(L,1,9),"|",$EXTRACT(L,1,9),"|",$EXTRACT(L,1,10),"|",$EXTRACT(L,1,5)
- +20 if '$DATA(PRNTALL)
- SET PRNTALL=1
- +21 DO ^PRCSP121
- DO ^PRCSP122
- if PRNTALL=0
- WRITE !,"VA FORM 90-2237-ADP MAR 1985",!
- if PRNTALL=1
- DO ^PRCSP123
- IF '$DATA(PRCHQ("DEST"))
- DO ^PRCSP124
- GOTO EXIT
- +22 IF $DATA(PRCHQ("DEST"))
- IF PRCHQ("DEST")'="F"
- DO ^PRCSP124
- EXIT KILL FPROJ,%DT,P,PRNTALL,X,X1,Y,Z,Z1,DA,DIWL,DIWR,DIWF,I,J,K,L,PRCS,^UTILITY($JOB,"W")
- if $DATA(ZTSK)
- DO KILL^%ZTLOAD
- QUIT