- PRCPAGRV ;WISC/RFJ-autogen print items with vendors not selected ;01 Dec 92
- ;;5.1;IFCAP;;Oct 20, 2000
- ;Per VHA Directive 10-93-142, this routine should not be modified.
- Q
- ;
- ;
- NOVEND ; print vendors not selected
- N %,%H,%I,DESCNSN,ITEMDA,NOW,PAGE,SCREEN,VDA,VNM,X,Y
- D NOW^%DTC S Y=% D DD^%DT S NOW=Y,PAGE=1,SCREEN=$$SCRPAUSE^PRCPUREP U IO D H
- S VNM="" F S VNM=$O(^TMP($J,"PRCPAG","NOV",VNM)) Q:VNM=""!($G(PRCPFLAG)) S VDA=0 F S VDA=$O(^TMP($J,"PRCPAG","NOV",VNM,VDA)) Q:'VDA!($G(PRCPFLAG)) D
- . W !!?7,"VENDOR: ",$S(VDA=0:"<< VENDOR NOT DEFINED >>",1:VNM),!
- . S DESCNSN="" F S DESCNSN=$O(^TMP($J,"PRCPAG","NOV",VNM,VDA,DESCNSN)) Q:DESCNSN="" S ITEMDA=0 F S ITEMDA=$O(^TMP($J,"PRCPAG","NOV",VNM,VDA,DESCNSN,ITEMDA)) Q:'ITEMDA!($G(PRCPFLAG)) D
- . . W !,ITEMDA,?7,$E($$DESCR^PRCPUX1(PRCP("I"),ITEMDA),1,54) W:PRCP("DPTYPE")="W" ?63,$$NSN^PRCPUX1(ITEMDA)
- . . I $Y>(IOSL-5) D:SCREEN P^PRCPUREP Q:$G(PRCPFLAG) D H
- I $G(PRCPFLAG) Q
- D END^PRCPUREP
- Q
- ;
- ;
- H S %=NOW_" PAGE "_PAGE,PAGE=PAGE+1 I PAGE'=2!(SCREEN) W @IOF
- W $C(13),"AUTO-GENERATION VENDORS AND ITEMS NOT SELECTED",?(80-$L(%)),%,!?5,"FOR INVENTORY POINT: ",PRCP("IN"),!,"MI#",?7,"DESCRIPTION" W:PRCP("DPTYPE")="W" ?63,"NSN" S %="",$P(%,"-",81)="" W !,%
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRCPAGRV 1269 printed Mar 13, 2025@21:17:27 Page 2
- PRCPAGRV ;WISC/RFJ-autogen print items with vendors not selected ;01 Dec 92
- +1 ;;5.1;IFCAP;;Oct 20, 2000
- +2 ;Per VHA Directive 10-93-142, this routine should not be modified.
- +3 QUIT
- +4 ;
- +5 ;
- NOVEND ; print vendors not selected
- +1 NEW %,%H,%I,DESCNSN,ITEMDA,NOW,PAGE,SCREEN,VDA,VNM,X,Y
- +2 DO NOW^%DTC
- SET Y=%
- DO DD^%DT
- SET NOW=Y
- SET PAGE=1
- SET SCREEN=$$SCRPAUSE^PRCPUREP
- USE IO
- DO H
- +3 SET VNM=""
- FOR
- SET VNM=$ORDER(^TMP($JOB,"PRCPAG","NOV",VNM))
- if VNM=""!($GET(PRCPFLAG))
- QUIT
- SET VDA=0
- FOR
- SET VDA=$ORDER(^TMP($JOB,"PRCPAG","NOV",VNM,VDA))
- if 'VDA!($GET(PRCPFLAG))
- QUIT
- Begin DoDot:1
- +4 WRITE !!?7,"VENDOR: ",$SELECT(VDA=0:"<< VENDOR NOT DEFINED >>",1:VNM),!
- +5 SET DESCNSN=""
- FOR
- SET DESCNSN=$ORDER(^TMP($JOB,"PRCPAG","NOV",VNM,VDA,DESCNSN))
- if DESCNSN=""
- QUIT
- SET ITEMDA=0
- FOR
- SET ITEMDA=$ORDER(^TMP($JOB,"PRCPAG","NOV",VNM,VDA,DESCNSN,ITEMDA))
- if 'ITEMDA!($GET(PRCPFLAG))
- QUIT
- Begin DoDot:2
- +6 WRITE !,ITEMDA,?7,$EXTRACT($$DESCR^PRCPUX1(PRCP("I"),ITEMDA),1,54)
- if PRCP("DPTYPE")="W"
- WRITE ?63,$$NSN^PRCPUX1(ITEMDA)
- +7 IF $Y>(IOSL-5)
- if SCREEN
- DO P^PRCPUREP
- if $GET(PRCPFLAG)
- QUIT
- DO H
- End DoDot:2
- End DoDot:1
- +8 IF $GET(PRCPFLAG)
- QUIT
- +9 DO END^PRCPUREP
- +10 QUIT
- +11 ;
- +12 ;
- H SET %=NOW_" PAGE "_PAGE
- SET PAGE=PAGE+1
- IF PAGE'=2!(SCREEN)
- WRITE @IOF
- +1 WRITE $CHAR(13),"AUTO-GENERATION VENDORS AND ITEMS NOT SELECTED",?(80-$LENGTH(%)),%,!?5,"FOR INVENTORY POINT: ",PRCP("IN"),!,"MI#",?7,"DESCRIPTION"
- if PRCP("DPTYPE")="W"
- WRITE ?63,"NSN"
- SET %=""
- SET $PIECE(%,"-",81)=""
- WRITE !,%
- +2 QUIT
