- PRCHRPT7 ;WISC/TKW-CONTINUATION OF PRINT SF18 FORM (QUOTATION) ;1/12/94 11:48 AM
- V ;;5.1;IFCAP;;Oct 20, 2000
- ;Per VHA Directive 10-93-142, this routine should not be modified.
- ;
- EN60 Q:'$D(PRC("SITE")) W !!! S DIC="^PRC(443,",DIC(0)="AEMQZ",DIC("A")="2237 REFERENCE NUMBER: "
- S DIC("S")="I $P(^(0),U,3)]"""",$D(^PRCS(410,+Y,0)),+^(0)=PRC(""SITE""),$P(^(0),U,2)=""O"",$D(^(7)),$P(^(7),U,6)]"""",$D(^(4)),$P(^(4),U,5)="""""
- D ^DIC K DIC G:Y<0 EXIT^PRCHP18 S PRCHD0=+Y
- K PRCHDT1,PRCHDT2 W !!,"Enter the date by which the quotations are to be returned to your office."
- S %DT="AEF",%DT("A")="RETURN BY (Date): " D ^%DT K %DT G:Y=-1 EN60 S PRCHDT1=Y
- W !!,"Then enter the date by which the delivery must be received." S %DT="AEF",%DT("A")="DELIVER BY (Date): " D ^%DT K %DT G:Y=-1 EN60 S PRCHDT2=Y
- I PRCHDT2'>PRCHDT1 W $C(7),!!,"** 'Deliver By Date' not greater then 'Return Quotation by Date' **" G EN60
- K ^TMP($J) W !!,"Select the Receiving Address to print in the block labeled 'DESTINATION'"
- N SITE,SUBSITE
- I $D(^PRC(411,"UP",PRC("SITE"))) D
- . I $P($G(^PRCS(410,PRCHD0,0)),U,10)]"" S SUBSITE=$P($G(^(0)),U,10)
- S SITE=$S($D(SUBSITE):SUBSITE,1:PRC("SITE"))
- S DIC="^PRC(411,"_SITE_",1,",DA(1)=SITE,DIC(0)="AEQMZ" D ^DIC G:Y=-1 EN60 S ^TMP($J,"D")=Y(0)
- W !!,"Enter VENDOR(S) to which the request for quotations are to be sent",! D ESEL I '$D(^TMP($J,"V")) G EN60
- W !!! K %ZIS,IOP S %ZIS="Q",IOP="Q",%ZIS("B")="" D ^%ZIS I POP K IOP D EXIT^PRCHP18 G EN60
- S IOP=ION_";"_IOST_";"_IOM_";"_IOSL,PRCHIOP=IOP K IOP
- S X=$O(^PRCD(442.3,"C",79,0)) I X,$D(^PRC(443,PRCHD0,0)) L ^PRC(443,PRCHD0,0):DTIME I $T S DIE="^PRC(443,",DA=PRCHD0,DR="1.5///"_X D ^DIE L K DIE,DA,DR
- I IO=IO(0) D ^%ZIS U IO D ^PRCHP18 D ^%ZISC D EXIT^PRCHP18 G EN60
- S ZTDTH=$H,ZTRTN="^PRCHP18",ZTDESC="Print Request for Quotations (SF18)"
- K ZTSAVE S ZTSAVE("PRCHD0")="",ZTSAVE("U")="",ZTSAVE("PRCHDT1")="",ZTSAVE("PRCHDT2")="",ZTSAVE("PRC(""SITE"")")="",ZTSAVE("^TMP($J,")="",ZTSAVE("D0")="",ZTSAVE("SITE")=""
- D ^%ZTLOAD,EXIT^PRCHP18
- G EN60
- ;
- ESEL S DIC="^PRC(440,",DIC(0)="AEQMZ" D ^DIC Q:Y=-1 S ^TMP($J,"V",+Y)=""
- G ESEL
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRCHRPT7 2135 printed Apr 23, 2025@18:25:03 Page 2
- PRCHRPT7 ;WISC/TKW-CONTINUATION OF PRINT SF18 FORM (QUOTATION) ;1/12/94 11:48 AM
- V ;;5.1;IFCAP;;Oct 20, 2000
- +1 ;Per VHA Directive 10-93-142, this routine should not be modified.
- +2 ;
- EN60 if '$DATA(PRC("SITE"))
- QUIT
- WRITE !!!
- SET DIC="^PRC(443,"
- SET DIC(0)="AEMQZ"
- SET DIC("A")="2237 REFERENCE NUMBER: "
- +1 SET DIC("S")="I $P(^(0),U,3)]"""",$D(^PRCS(410,+Y,0)),+^(0)=PRC(""SITE""),$P(^(0),U,2)=""O"",$D(^(7)),$P(^(7),U,6)]"""",$D(^(4)),$P(^(4),U,5)="""""
- +2 DO ^DIC
- KILL DIC
- if Y<0
- GOTO EXIT^PRCHP18
- SET PRCHD0=+Y
- +3 KILL PRCHDT1,PRCHDT2
- WRITE !!,"Enter the date by which the quotations are to be returned to your office."
- +4 SET %DT="AEF"
- SET %DT("A")="RETURN BY (Date): "
- DO ^%DT
- KILL %DT
- if Y=-1
- GOTO EN60
- SET PRCHDT1=Y
- +5 WRITE !!,"Then enter the date by which the delivery must be received."
- SET %DT="AEF"
- SET %DT("A")="DELIVER BY (Date): "
- DO ^%DT
- KILL %DT
- if Y=-1
- GOTO EN60
- SET PRCHDT2=Y
- +6 IF PRCHDT2'>PRCHDT1
- WRITE $CHAR(7),!!,"** 'Deliver By Date' not greater then 'Return Quotation by Date' **"
- GOTO EN60
- +7 KILL ^TMP($JOB)
- WRITE !!,"Select the Receiving Address to print in the block labeled 'DESTINATION'"
- +8 NEW SITE,SUBSITE
- +9 IF $DATA(^PRC(411,"UP",PRC("SITE")))
- Begin DoDot:1
- +10 IF $PIECE($GET(^PRCS(410,PRCHD0,0)),U,10)]""
- SET SUBSITE=$PIECE($GET(^(0)),U,10)
- End DoDot:1
- +11 SET SITE=$SELECT($DATA(SUBSITE):SUBSITE,1:PRC("SITE"))
- +12 SET DIC="^PRC(411,"_SITE_",1,"
- SET DA(1)=SITE
- SET DIC(0)="AEQMZ"
- DO ^DIC
- if Y=-1
- GOTO EN60
- SET ^TMP($JOB,"D")=Y(0)
- +13 WRITE !!,"Enter VENDOR(S) to which the request for quotations are to be sent",!
- DO ESEL
- IF '$DATA(^TMP($JOB,"V"))
- GOTO EN60
- +14 WRITE !!!
- KILL %ZIS,IOP
- SET %ZIS="Q"
- SET IOP="Q"
- SET %ZIS("B")=""
- DO ^%ZIS
- IF POP
- KILL IOP
- DO EXIT^PRCHP18
- GOTO EN60
- +15 SET IOP=ION_";"_IOST_";"_IOM_";"_IOSL
- SET PRCHIOP=IOP
- KILL IOP
- +16 SET X=$ORDER(^PRCD(442.3,"C",79,0))
- IF X
- IF $DATA(^PRC(443,PRCHD0,0))
- LOCK ^PRC(443,PRCHD0,0):DTIME
- IF $TEST
- SET DIE="^PRC(443,"
- SET DA=PRCHD0
- SET DR="1.5///"_X
- DO ^DIE
- LOCK
- KILL DIE,DA,DR
- +17 IF IO=IO(0)
- DO ^%ZIS
- USE IO
- DO ^PRCHP18
- DO ^%ZISC
- DO EXIT^PRCHP18
- GOTO EN60
- +18 SET ZTDTH=$HOROLOG
- SET ZTRTN="^PRCHP18"
- SET ZTDESC="Print Request for Quotations (SF18)"
- +19 KILL ZTSAVE
- SET ZTSAVE("PRCHD0")=""
- SET ZTSAVE("U")=""
- SET ZTSAVE("PRCHDT1")=""
- SET ZTSAVE("PRCHDT2")=""
- SET ZTSAVE("PRC(""SITE"")")=""
- SET ZTSAVE("^TMP($J,")=""
- SET ZTSAVE("D0")=""
- SET ZTSAVE("SITE")=""
- +20 DO ^%ZTLOAD
- DO EXIT^PRCHP18
- +21 GOTO EN60
- +22 ;
- ESEL SET DIC="^PRC(440,"
- SET DIC(0)="AEQMZ"
- DO ^DIC
- if Y=-1
- QUIT
- SET ^TMP($JOB,"V",+Y)=""
- +1 GOTO ESEL
