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 Apr 09, 2024@21:20:14 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
