- PRCPRCFP ;WISC/RFJ/DST-conversion factor report (primary, secondary) ;09 Jun 93
- ;;5.1;IFCAP;**98**;Oct 20, 2000;Build 37
- ;Per VHA Directive 2004-038, this routine should not be modified.
- Q
- ;
- ;
- PRIMARY ; conversion factor report for primary and secondary
- N GROUPALL,X
- K X S X(1)="The Conversion Factor Report will display the inventory point items with procurement sources and conversion factors."
- S X(2)="This report will sort the Primary and Secondary inventory items by the Group Category, Description, and Procurement Source."
- D DISPLAY^PRCPUX2(40,79,.X)
- K X S X(1)="Select the Group Categories to display" D DISPLAY^PRCPUX2(2,40,.X)
- D GROUPSEL^PRCPURS1(PRCP("I"))
- I '$G(GROUPALL),'$O(^TMP($J,"PRCPURS1","YES",0)) W !,"*** NO GROUP CATEGORIES SELECTED !" D Q Q
- W !,"NOTE: The report will",$S('$G(GROUPALL):" NOT",1:"")," include items not stored in a group category."
- ; Prompt for On-Demand Item selection, if not warehouse
- N ODIS
- S ODIS=$$ODIPROM^PRCPUX2(0)
- I 'ODIS D Q Q
- ;
- W ! S %ZIS="Q" D ^%ZIS Q:POP I $D(IO("Q")) D D ^%ZTLOAD K IO("Q"),ZTSK Q
- . S ZTDESC="Conversion Factor Report",ZTRTN="DQ^PRCPRCFP"
- . S ZTSAVE("PRCP*")="",ZTSAVE("GROUPALL")="",ZTSAVE("ODIS")="",ZTSAVE("^TMP($J,""PRCPURS1"",")="",ZTSAVE("ZTREQ")="@"
- W !!,"<*> please wait <*>"
- DQ ; queue starts here
- N %,%H,%I,DESCR,GROUP,GROUPNM,ITEMDA,ITEMDATA,NOW,NSN,PAGE,PRCPFLAG,SCREEN,VENDATA,VENNM,X,Y
- N ODI ; On-Demand Item flag
- K ^TMP($J,"PRCPRCFP")
- S ITEMDA=0 F S ITEMDA=$O(^PRCP(445,PRCP("I"),1,ITEMDA)) Q:'ITEMDA D
- . S ITEMDATA=$G(^PRCP(445,PRCP("I"),1,ITEMDA,0))
- . S GROUP=+$P(ITEMDATA,"^",21)
- . I 'GROUP,'$G(GROUPALL) Q
- . I $G(GROUPALL),$D(^TMP($J,"PRCPURS1","NO",GROUP)) Q
- . I '$G(GROUPALL),'$D(^TMP($J,"PRCPURS1","YES",GROUP)) Q
- . S GROUPNM=$$GROUPNM^PRCPEGRP(GROUP)
- . I GROUPNM'="" S GROUPNM=$E(GROUPNM,1,20)_" (#"_GROUP_")"
- . S:GROUPNM="" GROUPNM=" "
- . S DESCR=$$DESCR^PRCPUX1(PRCP("I"),ITEMDA) S:DESCR="" DESCR=" "
- . S X=0 F S X=$O(^PRCP(445,PRCP("I"),1,ITEMDA,5,X)) Q:'X S VENDATA=$G(^(X,0)) I VENDATA'="" D
- . . S VENNM=$$VENNAME^PRCPUX1($P(VENDATA,"^")) S:VENNM="" VENNM=" "
- . . S ^TMP($J,"PRCPRCFP",GROUPNM,$E(DESCR,1,30),ITEMDA,$E(VENNM,1,20))=VENDATA
- ; print report
- D NOW^%DTC S Y=% D DD^%DT S NOW=Y,PAGE=1,SCREEN=$$SCRPAUSE^PRCPUREP U IO D H
- S GROUP="" F S GROUP=$O(^TMP($J,"PRCPRCFP",GROUP)) Q:GROUP=""!($G(PRCPFLAG)) D
- . I $Y>(IOSL-6) D:SCREEN P^PRCPUREP Q:$D(PRCPFLAG) D H
- . W !!?5,"GROUP: ",$S(GROUP=" ":"<<NONE>>",1:GROUP)
- . S DESCR="" F S DESCR=$O(^TMP($J,"PRCPRCFP",GROUP,DESCR)) Q:DESCR=""!($G(PRCPFLAG)) S ITEMDA=0 F S ITEMDA=$O(^TMP($J,"PRCPRCFP",GROUP,DESCR,ITEMDA)) Q:'ITEMDA!($G(PRCPFLAG)) D
- . . I $Y>(IOSL-6) D:SCREEN P^PRCPUREP Q:$D(PRCPFLAG) D H
- . . S ITEMDATA=$G(^PRCP(445,PRCP("I"),1,ITEMDA,0))
- . . ; On-Demand Item flag check and display
- . . S ODI=$$ODITEM^PRCPUX2(PRCP("I"),ITEMDA)
- . . Q:(ODIS=1)&(ODI="Y")
- . . Q:(ODIS=2)&(ODI'="Y")
- . . ;
- . . W !,DESCR,?32,$S(ODI="Y":"D",1:""),?46,ITEMDA,?53,$J(+$P(ITEMDATA,"^",7),8),$J($$UNIT^PRCPUX1(PRCP("I"),ITEMDA,"/"),10)
- . . S VENNM="" F S VENNM=$O(^TMP($J,"PRCPRCFP",GROUP,DESCR,ITEMDA,VENNM)) Q:VENNM=""!($G(PRCPFLAG)) S VENDATA=^(VENNM) D
- . . . I $Y>(IOSL-6) D:SCREEN P^PRCPUREP Q:$D(PRCPFLAG) D H
- . . . S %=$S($P(VENDATA,"^")["PRCP(445":"I#",1:"V#")_+VENDATA
- . . . W !?29,VENNM,?51,$J(%,8),?61,$J($$UNITVAL^PRCPUX1($P(VENDATA,"^",3),$P(VENDATA,"^",2),"/"),10),$J($P(VENDATA,"^",4),9)
- . I $G(ZTQUEUED),$$S^%ZTLOAD S PRCPFLAG=1 W !?10,"<<< TASKMANAGER JOB TERMINATED BY USER >>>"
- I '$G(PRCPFLAG) D END^PRCPUREP
- Q D ^%ZISC K ^TMP($J,"PRCPRCFP"),^TMP($J,"PRCPURS1")
- Q
- ;
- H S %=NOW_" PAGE "_PAGE,PAGE=PAGE+1 I PAGE'=2!(SCREEN) W @IOF
- W $C(13),"CONVERSION FACTOR REPORT FOR: ",$E(PRCP("IN"),1,20),?(80-$L(%)),%
- W !,$S(ODIS=2:"ON-DEMAND ITEMS ONLY",ODIS=3:"ALL ITEMS (STANDARD AND ON-DEMAND)",1:"STANDARD ITEMS ONLY")
- S %="",$P(%,"-",81)=""
- W !,"DESCRIPTION",?32,"OD",?46,"IM",$J("QTY OH",13),$J("UNIT/IS",10)
- W !?29,"PROCUREMENT SOURCE",?55,"IV#",?61,$J("UNIT/RE",10),$J("CF",9),!,%
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRCPRCFP 4187 printed Feb 18, 2025@23:41 Page 2
- PRCPRCFP ;WISC/RFJ/DST-conversion factor report (primary, secondary) ;09 Jun 93
- +1 ;;5.1;IFCAP;**98**;Oct 20, 2000;Build 37
- +2 ;Per VHA Directive 2004-038, this routine should not be modified.
- +3 QUIT
- +4 ;
- +5 ;
- PRIMARY ; conversion factor report for primary and secondary
- +1 NEW GROUPALL,X
- +2 KILL X
- SET X(1)="The Conversion Factor Report will display the inventory point items with procurement sources and conversion factors."
- +3 SET X(2)="This report will sort the Primary and Secondary inventory items by the Group Category, Description, and Procurement Source."
- +4 DO DISPLAY^PRCPUX2(40,79,.X)
- +5 KILL X
- SET X(1)="Select the Group Categories to display"
- DO DISPLAY^PRCPUX2(2,40,.X)
- +6 DO GROUPSEL^PRCPURS1(PRCP("I"))
- +7 IF '$GET(GROUPALL)
- IF '$ORDER(^TMP($JOB,"PRCPURS1","YES",0))
- WRITE !,"*** NO GROUP CATEGORIES SELECTED !"
- DO Q
- QUIT
- +8 WRITE !,"NOTE: The report will",$SELECT('$GET(GROUPALL):" NOT",1:"")," include items not stored in a group category."
- +9 ; Prompt for On-Demand Item selection, if not warehouse
- +10 NEW ODIS
- +11 SET ODIS=$$ODIPROM^PRCPUX2(0)
- +12 IF 'ODIS
- DO Q
- QUIT
- +13 ;
- +14 WRITE !
- SET %ZIS="Q"
- DO ^%ZIS
- if POP
- QUIT
- IF $DATA(IO("Q"))
- Begin DoDot:1
- +15 SET ZTDESC="Conversion Factor Report"
- SET ZTRTN="DQ^PRCPRCFP"
- +16 SET ZTSAVE("PRCP*")=""
- SET ZTSAVE("GROUPALL")=""
- SET ZTSAVE("ODIS")=""
- SET ZTSAVE("^TMP($J,""PRCPURS1"",")=""
- SET ZTSAVE("ZTREQ")="@"
- End DoDot:1
- DO ^%ZTLOAD
- KILL IO("Q"),ZTSK
- QUIT
- +17 WRITE !!,"<*> please wait <*>"
- DQ ; queue starts here
- +1 NEW %,%H,%I,DESCR,GROUP,GROUPNM,ITEMDA,ITEMDATA,NOW,NSN,PAGE,PRCPFLAG,SCREEN,VENDATA,VENNM,X,Y
- +2 ; On-Demand Item flag
- NEW ODI
- +3 KILL ^TMP($JOB,"PRCPRCFP")
- +4 SET ITEMDA=0
- FOR
- SET ITEMDA=$ORDER(^PRCP(445,PRCP("I"),1,ITEMDA))
- if 'ITEMDA
- QUIT
- Begin DoDot:1
- +5 SET ITEMDATA=$GET(^PRCP(445,PRCP("I"),1,ITEMDA,0))
- +6 SET GROUP=+$PIECE(ITEMDATA,"^",21)
- +7 IF 'GROUP
- IF '$GET(GROUPALL)
- QUIT
- +8 IF $GET(GROUPALL)
- IF $DATA(^TMP($JOB,"PRCPURS1","NO",GROUP))
- QUIT
- +9 IF '$GET(GROUPALL)
- IF '$DATA(^TMP($JOB,"PRCPURS1","YES",GROUP))
- QUIT
- +10 SET GROUPNM=$$GROUPNM^PRCPEGRP(GROUP)
- +11 IF GROUPNM'=""
- SET GROUPNM=$EXTRACT(GROUPNM,1,20)_" (#"_GROUP_")"
- +12 if GROUPNM=""
- SET GROUPNM=" "
- +13 SET DESCR=$$DESCR^PRCPUX1(PRCP("I"),ITEMDA)
- if DESCR=""
- SET DESCR=" "
- +14 SET X=0
- FOR
- SET X=$ORDER(^PRCP(445,PRCP("I"),1,ITEMDA,5,X))
- if 'X
- QUIT
- SET VENDATA=$GET(^(X,0))
- IF VENDATA'=""
- Begin DoDot:2
- +15 SET VENNM=$$VENNAME^PRCPUX1($PIECE(VENDATA,"^"))
- if VENNM=""
- SET VENNM=" "
- +16 SET ^TMP($JOB,"PRCPRCFP",GROUPNM,$EXTRACT(DESCR,1,30),ITEMDA,$EXTRACT(VENNM,1,20))=VENDATA
- End DoDot:2
- End DoDot:1
- +17 ; print report
- +18 DO NOW^%DTC
- SET Y=%
- DO DD^%DT
- SET NOW=Y
- SET PAGE=1
- SET SCREEN=$$SCRPAUSE^PRCPUREP
- USE IO
- DO H
- +19 SET GROUP=""
- FOR
- SET GROUP=$ORDER(^TMP($JOB,"PRCPRCFP",GROUP))
- if GROUP=""!($GET(PRCPFLAG))
- QUIT
- Begin DoDot:1
- +20 IF $Y>(IOSL-6)
- if SCREEN
- DO P^PRCPUREP
- if $DATA(PRCPFLAG)
- QUIT
- DO H
- +21 WRITE !!?5,"GROUP: ",$SELECT(GROUP=" ":"<<NONE>>",1:GROUP)
- +22 SET DESCR=""
- FOR
- SET DESCR=$ORDER(^TMP($JOB,"PRCPRCFP",GROUP,DESCR))
- if DESCR=""!($GET(PRCPFLAG))
- QUIT
- SET ITEMDA=0
- FOR
- SET ITEMDA=$ORDER(^TMP($JOB,"PRCPRCFP",GROUP,DESCR,ITEMDA))
- if 'ITEMDA!($GET(PRCPFLAG))
- QUIT
- Begin DoDot:2
- +23 IF $Y>(IOSL-6)
- if SCREEN
- DO P^PRCPUREP
- if $DATA(PRCPFLAG)
- QUIT
- DO H
- +24 SET ITEMDATA=$GET(^PRCP(445,PRCP("I"),1,ITEMDA,0))
- +25 ; On-Demand Item flag check and display
- +26 SET ODI=$$ODITEM^PRCPUX2(PRCP("I"),ITEMDA)
- +27 if (ODIS=1)&(ODI="Y")
- QUIT
- +28 if (ODIS=2)&(ODI'="Y")
- QUIT
- +29 ;
- +30 WRITE !,DESCR,?32,$SELECT(ODI="Y":"D",1:""),?46,ITEMDA,?53,$JUSTIFY(+$PIECE(ITEMDATA,"^",7),8),$JUSTIFY($$UNIT^PRCPUX1(PRCP("I"),ITEMDA,"/"),10)
- +31 SET VENNM=""
- FOR
- SET VENNM=$ORDER(^TMP($JOB,"PRCPRCFP",GROUP,DESCR,ITEMDA,VENNM))
- if VENNM=""!($GET(PRCPFLAG))
- QUIT
- SET VENDATA=^(VENNM)
- Begin DoDot:3
- +32 IF $Y>(IOSL-6)
- if SCREEN
- DO P^PRCPUREP
- if $DATA(PRCPFLAG)
- QUIT
- DO H
- +33 SET %=$SELECT($PIECE(VENDATA,"^")["PRCP(445":"I#",1:"V#")_+VENDATA
- +34 WRITE !?29,VENNM,?51,$JUSTIFY(%,8),?61,$JUSTIFY($$UNITVAL^PRCPUX1($PIECE(VENDATA,"^",3),$PIECE(VENDATA,"^",2),"/"),10),$JUSTIFY($PIECE(VENDATA,"^",4),9)
- End DoDot:3
- End DoDot:2
- +35 IF $GET(ZTQUEUED)
- IF $$S^%ZTLOAD
- SET PRCPFLAG=1
- WRITE !?10,"<<< TASKMANAGER JOB TERMINATED BY USER >>>"
- End DoDot:1
- +36 IF '$GET(PRCPFLAG)
- DO END^PRCPUREP
- Q DO ^%ZISC
- KILL ^TMP($JOB,"PRCPRCFP"),^TMP($JOB,"PRCPURS1")
- +1 QUIT
- +2 ;
- H SET %=NOW_" PAGE "_PAGE
- SET PAGE=PAGE+1
- IF PAGE'=2!(SCREEN)
- WRITE @IOF
- +1 WRITE $CHAR(13),"CONVERSION FACTOR REPORT FOR: ",$EXTRACT(PRCP("IN"),1,20),?(80-$LENGTH(%)),%
- +2 WRITE !,$SELECT(ODIS=2:"ON-DEMAND ITEMS ONLY",ODIS=3:"ALL ITEMS (STANDARD AND ON-DEMAND)",1:"STANDARD ITEMS ONLY")
- +3 SET %=""
- SET $PIECE(%,"-",81)=""
- +4 WRITE !,"DESCRIPTION",?32,"OD",?46,"IM",$JUSTIFY("QTY OH",13),$JUSTIFY("UNIT/IS",10)
- +5 WRITE !?29,"PROCUREMENT SOURCE",?55,"IV#",?61,$JUSTIFY("UNIT/RE",10),$JUSTIFY("CF",9),!,%
- +6 QUIT