- PRCPRAVP ;WISC/RFJ-availability list report (primary) ;18 May 93
- ;;5.1;IFCAP;;Oct 20, 2000
- ;Per VHA Directive 10-93-142, this routine should not be modified.
- Q
- ;
- ;
- PRIMARY ; availability list for primary (called from prcpravl)
- N GROUPALL,PRCPSUMM
- K X S X(1)="The Availability Listing will display the current quantity and value of the inventory point items. The report will sort Primary or Secondary inventory items by Group Category and Description." D DISPLAY^PRCPUX2(40,79,.X)
- S PRCPSUMM=$$SUMMARY^PRCPURS0 I PRCPSUMM<0 Q
- I PRCPSUMM S GROUPALL=1 G DEVICE
- K X S X(1)="Select the Group Categories to display" W ! 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."
- DEVICE W ! S %ZIS="Q" D ^%ZIS G:POP Q I $D(IO("Q")) D D ^%ZTLOAD K IO("Q"),ZTSK D Q Q
- . S ZTDESC="Primary Availability Listing",ZTRTN="DQ^PRCPRAVP"
- . S ZTSAVE("PRCP*")="",ZTSAVE("GROUPALL")="",ZTSAVE("^TMP($J,""PRCPURS1"",")="",ZTSAVE("ZTREQ")="@"
- W !!,"<*> please wait <*>"
- DQ ; queue starts here
- N %I,DESCR,DESCRIP,GROUP,GROUPNM,ITEMDA,ITEMDATA,NOW,NSN,PAGE,PRCPFLAG,SCREEN,TOTAL,TOTINV,X,Y
- K ^TMP($J,"PRCPRAVP"),^TMP($J,"PRCPRAVP TOT")
- S ITEMDA=0 F S ITEMDA=$O(^PRCP(445,PRCP("I"),1,ITEMDA)) Q:'ITEMDA S ITEMDATA=$G(^(ITEMDA,0)) D
- . 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 ^TMP($J,"PRCPRAVP",GROUPNM,$E(DESCR,1,15),ITEMDA)=DESCR
- ; print report
- D NOW^%DTC S Y=% D DD^%DT S NOW=Y,PAGE=1,SCREEN=$$SCRPAUSE^PRCPUREP U IO D H
- S GROUPNM="" F S GROUPNM=$O(^TMP($J,"PRCPRAVP",GROUPNM)) Q:GROUPNM=""!($G(PRCPFLAG)) D
- . I $Y>(IOSL-6) D:SCREEN P^PRCPUREP Q:$D(PRCPFLAG) D H
- . W:'PRCPSUMM !!?5,"GROUP NAME: ",$S(GROUPNM=" ":"<<ITEMS NOT STORED IN A GROUP CATEGORY>>",1:GROUPNM)
- . S DESCR="" F S DESCR=$O(^TMP($J,"PRCPRAVP",GROUPNM,DESCR)) Q:DESCR=""!($G(PRCPFLAG)) S ITEMDA=0 F S ITEMDA=$O(^TMP($J,"PRCPRAVP",GROUPNM,DESCR,ITEMDA)) Q:'ITEMDA!($G(PRCPFLAG)) D
- . . S DESCRIP=^TMP($J,"PRCPRAVP",GROUPNM,DESCR,ITEMDA)
- . . S ITEMDATA=$G(^PRCP(445,PRCP("I"),1,ITEMDA,0))
- . . S NSN=$$NSN^PRCPUX1(ITEMDA) S:NSN="" NSN="<<NO NSN>>"
- . . W:'PRCPSUMM !!,$TR(NSN,"-"),?15,$E(DESCRIP,1,38),?54,"[",ITEMDA,"]",?63,$J($$UNIT^PRCPUX1(PRCP("I"),ITEMDA,"/"),8),?79,$S($P(ITEMDATA,"^",26)="Y":"*",1:"")
- . . W:'PRCPSUMM !,$J("ONHAND",16),$J("DUEIN",8),$J("DUEOUT",8),$J("REORDPT",8),$J("ISSMUL",8),$J("AVGCOST",10),$J("TOTVALUE",22)
- . . W:'PRCPSUMM !,$J(+$P(ITEMDATA,"^",7),16),$J($$GETIN^PRCPUDUE(PRCP("I"),ITEMDA),8),$J($$GETOUT^PRCPUDUE(PRCP("I"),ITEMDA),8),$J(+$P(ITEMDATA,"^",10),8)
- . . W:'PRCPSUMM $J($P(ITEMDATA,"^",25),8),$J($P(ITEMDATA,"^",22),10,3)
- . . I +$J($P(ITEMDATA,"^",7)*$P(ITEMDATA,"^",22),0,2)'=+$P(ITEMDATA,"^",27) W:'PRCPSUMM " <=/=>"
- . . W:'PRCPSUMM ?64,$J($P(ITEMDATA,"^",27),15,2)
- . . S ^TMP($J,"PRCPRAVP TOT",GROUPNM)=$G(^TMP($J,"PRCPRAVP TOT",GROUPNM))+$P(ITEMDATA,"^",27)
- . . I $Y>(IOSL-6) D:SCREEN P^PRCPUREP Q:$D(PRCPFLAG) D H
- . I $G(ZTQUEUED),$$S^%ZTLOAD S PRCPFLAG=1 W !?10,"<<< TASKMANAGER JOB TERMINATED BY USER >>>"
- I $G(PRCPFLAG) D Q Q
- I $Y>(IOSL-6) D:SCREEN P^PRCPUREP Q:$D(PRCPFLAG) D H
- W !!?2,"TOTALS :",?40,"INVENTORY VALUE",!?2,"--------",?40,"---------------"
- S TOTINV=0,GROUPNM="" F S GROUPNM=$O(^TMP($J,"PRCPRAVP TOT",GROUPNM)) Q:GROUPNM=""!($G(PRCPFLAG)) S TOTAL=^(GROUPNM) D
- . W !?2,"GROUP ",$S(GROUPNM=" ":"<<NONE>>",1:GROUPNM),?40,":",$J(TOTAL,14,2)
- . S TOTINV=TOTINV+TOTAL
- . I $Y>(IOSL-6) D:SCREEN P^PRCPUREP Q:$D(PRCPFLAG) D H
- W !?2,"--------",?40,"---------------"
- W !?2,"TOTALS :",?40,$J(TOTINV,15,2)
- D END^PRCPUREP
- Q D ^%ZISC K ^TMP($J,"PRCPRAVP"),^TMP($J,"PRCPRAVP TOT"),^TMP($J,"PRCPRURS1")
- Q
- ;
- H S %=NOW_" PAGE "_PAGE,PAGE=PAGE+1 I PAGE'=2!(SCREEN) W @IOF
- W $C(13),"AVAILABILITY LISTING FOR: ",$E(PRCP("IN"),1,20),?(80-$L(%)),%
- S %="",$P(%,"-",81)=""
- I PRCPSUMM W !?1,"*** ONLY SUMMARY OF ITEMS PRINTED ***",!,% Q
- W !,"DESCR",?15,"DESCRIPTION",?40,"MI",$J("UNIT/IS",14),?77,"KWZ",!,%
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRCPRAVP 4555 printed Jan 18, 2025@03:15:47 Page 2
- PRCPRAVP ;WISC/RFJ-availability list report (primary) ;18 May 93
- +1 ;;5.1;IFCAP;;Oct 20, 2000
- +2 ;Per VHA Directive 10-93-142, this routine should not be modified.
- +3 QUIT
- +4 ;
- +5 ;
- PRIMARY ; availability list for primary (called from prcpravl)
- +1 NEW GROUPALL,PRCPSUMM
- +2 KILL X
- SET X(1)="The Availability Listing will display the current quantity and value of the inventory point items. The report will sort Primary or Secondary inventory items by Group Category and Description."
- DO DISPLAY^PRCPUX2(40,79,.X)
- +3 SET PRCPSUMM=$$SUMMARY^PRCPURS0
- IF PRCPSUMM<0
- QUIT
- +4 IF PRCPSUMM
- SET GROUPALL=1
- GOTO DEVICE
- +5 KILL X
- SET X(1)="Select the Group Categories to display"
- WRITE !
- 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."
- DEVICE WRITE !
- SET %ZIS="Q"
- DO ^%ZIS
- if POP
- GOTO Q
- IF $DATA(IO("Q"))
- Begin DoDot:1
- +1 SET ZTDESC="Primary Availability Listing"
- SET ZTRTN="DQ^PRCPRAVP"
- +2 SET ZTSAVE("PRCP*")=""
- SET ZTSAVE("GROUPALL")=""
- SET ZTSAVE("^TMP($J,""PRCPURS1"",")=""
- SET ZTSAVE("ZTREQ")="@"
- End DoDot:1
- DO ^%ZTLOAD
- KILL IO("Q"),ZTSK
- DO Q
- QUIT
- +3 WRITE !!,"<*> please wait <*>"
- DQ ; queue starts here
- +1 NEW %I,DESCR,DESCRIP,GROUP,GROUPNM,ITEMDA,ITEMDATA,NOW,NSN,PAGE,PRCPFLAG,SCREEN,TOTAL,TOTINV,X,Y
- +2 KILL ^TMP($JOB,"PRCPRAVP"),^TMP($JOB,"PRCPRAVP TOT")
- +3 SET ITEMDA=0
- FOR
- SET ITEMDA=$ORDER(^PRCP(445,PRCP("I"),1,ITEMDA))
- if 'ITEMDA
- QUIT
- SET ITEMDATA=$GET(^(ITEMDA,0))
- Begin DoDot:1
- +4 SET GROUP=+$PIECE(ITEMDATA,"^",21)
- +5 IF 'GROUP
- IF '$GET(GROUPALL)
- QUIT
- +6 IF $GET(GROUPALL)
- IF $DATA(^TMP($JOB,"PRCPURS1","NO",GROUP))
- QUIT
- +7 IF '$GET(GROUPALL)
- IF '$DATA(^TMP($JOB,"PRCPURS1","YES",GROUP))
- QUIT
- +8 SET GROUPNM=$$GROUPNM^PRCPEGRP(GROUP)
- +9 IF GROUPNM'=""
- SET GROUPNM=$EXTRACT(GROUPNM,1,20)_" (#"_GROUP_")"
- +10 if GROUPNM=""
- SET GROUPNM=" "
- +11 SET DESCR=$$DESCR^PRCPUX1(PRCP("I"),ITEMDA)
- if DESCR=""
- SET DESCR=" "
- +12 SET ^TMP($JOB,"PRCPRAVP",GROUPNM,$EXTRACT(DESCR,1,15),ITEMDA)=DESCR
- End DoDot:1
- +13 ; print report
- +14 DO NOW^%DTC
- SET Y=%
- DO DD^%DT
- SET NOW=Y
- SET PAGE=1
- SET SCREEN=$$SCRPAUSE^PRCPUREP
- USE IO
- DO H
- +15 SET GROUPNM=""
- FOR
- SET GROUPNM=$ORDER(^TMP($JOB,"PRCPRAVP",GROUPNM))
- if GROUPNM=""!($GET(PRCPFLAG))
- QUIT
- Begin DoDot:1
- +16 IF $Y>(IOSL-6)
- if SCREEN
- DO P^PRCPUREP
- if $DATA(PRCPFLAG)
- QUIT
- DO H
- +17 if 'PRCPSUMM
- WRITE !!?5,"GROUP NAME: ",$SELECT(GROUPNM=" ":"<<ITEMS NOT STORED IN A GROUP CATEGORY>>",1:GROUPNM)
- +18 SET DESCR=""
- FOR
- SET DESCR=$ORDER(^TMP($JOB,"PRCPRAVP",GROUPNM,DESCR))
- if DESCR=""!($GET(PRCPFLAG))
- QUIT
- SET ITEMDA=0
- FOR
- SET ITEMDA=$ORDER(^TMP($JOB,"PRCPRAVP",GROUPNM,DESCR,ITEMDA))
- if 'ITEMDA!($GET(PRCPFLAG))
- QUIT
- Begin DoDot:2
- +19 SET DESCRIP=^TMP($JOB,"PRCPRAVP",GROUPNM,DESCR,ITEMDA)
- +20 SET ITEMDATA=$GET(^PRCP(445,PRCP("I"),1,ITEMDA,0))
- +21 SET NSN=$$NSN^PRCPUX1(ITEMDA)
- if NSN=""
- SET NSN="<<NO NSN>>"
- +22 if 'PRCPSUMM
- WRITE !!,$TRANSLATE(NSN,"-"),?15,$EXTRACT(DESCRIP,1,38),?54,"[",ITEMDA,"]",?63,$JUSTIFY($$UNIT^PRCPUX1(PRCP("I"),ITEMDA,"/"),8),?79,$SELECT($PIECE(ITEMDATA,"^",26)="Y":"*",1:"")
- +23 if 'PRCPSUMM
- WRITE !,$JUSTIFY("ONHAND",16),$JUSTIFY("DUEIN",8),$JUSTIFY("DUEOUT",8),$JUSTIFY("REORDPT",8),$JUSTIFY("ISSMUL",8),$JUSTIFY("AVGCOST",10),$JUSTIFY("TOTVALUE",22)
- +24 if 'PRCPSUMM
- WRITE !,$JUSTIFY(+$PIECE(ITEMDATA,"^",7),16),$JUSTIFY($$GETIN^PRCPUDUE(PRCP("I"),ITEMDA),8),$JUSTIFY($$GETOUT^PRCPUDUE(PRCP("I"),ITEMDA),8),$JUSTIFY(+$PIECE(ITEMDATA,"^",10),8)
- +25 if 'PRCPSUMM
- WRITE $JUSTIFY($PIECE(ITEMDATA,"^",25),8),$JUSTIFY($PIECE(ITEMDATA,"^",22),10,3)
- +26 IF +$JUSTIFY($PIECE(ITEMDATA,"^",7)*$PIECE(ITEMDATA,"^",22),0,2)'=+$PIECE(ITEMDATA,"^",27)
- if 'PRCPSUMM
- WRITE " <=/=>"
- +27 if 'PRCPSUMM
- WRITE ?64,$JUSTIFY($PIECE(ITEMDATA,"^",27),15,2)
- +28 SET ^TMP($JOB,"PRCPRAVP TOT",GROUPNM)=$GET(^TMP($JOB,"PRCPRAVP TOT",GROUPNM))+$PIECE(ITEMDATA,"^",27)
- +29 IF $Y>(IOSL-6)
- if SCREEN
- DO P^PRCPUREP
- if $DATA(PRCPFLAG)
- QUIT
- DO H
- End DoDot:2
- +30 IF $GET(ZTQUEUED)
- IF $$S^%ZTLOAD
- SET PRCPFLAG=1
- WRITE !?10,"<<< TASKMANAGER JOB TERMINATED BY USER >>>"
- End DoDot:1
- +31 IF $GET(PRCPFLAG)
- DO Q
- QUIT
- +32 IF $Y>(IOSL-6)
- if SCREEN
- DO P^PRCPUREP
- if $DATA(PRCPFLAG)
- QUIT
- DO H
- +33 WRITE !!?2,"TOTALS :",?40,"INVENTORY VALUE",!?2,"--------",?40,"---------------"
- +34 SET TOTINV=0
- SET GROUPNM=""
- FOR
- SET GROUPNM=$ORDER(^TMP($JOB,"PRCPRAVP TOT",GROUPNM))
- if GROUPNM=""!($GET(PRCPFLAG))
- QUIT
- SET TOTAL=^(GROUPNM)
- Begin DoDot:1
- +35 WRITE !?2,"GROUP ",$SELECT(GROUPNM=" ":"<<NONE>>",1:GROUPNM),?40,":",$JUSTIFY(TOTAL,14,2)
- +36 SET TOTINV=TOTINV+TOTAL
- +37 IF $Y>(IOSL-6)
- if SCREEN
- DO P^PRCPUREP
- if $DATA(PRCPFLAG)
- QUIT
- DO H
- End DoDot:1
- +38 WRITE !?2,"--------",?40,"---------------"
- +39 WRITE !?2,"TOTALS :",?40,$JUSTIFY(TOTINV,15,2)
- +40 DO END^PRCPUREP
- Q DO ^%ZISC
- KILL ^TMP($JOB,"PRCPRAVP"),^TMP($JOB,"PRCPRAVP TOT"),^TMP($JOB,"PRCPRURS1")
- +1 QUIT
- +2 ;
- H SET %=NOW_" PAGE "_PAGE
- SET PAGE=PAGE+1
- IF PAGE'=2!(SCREEN)
- WRITE @IOF
- +1 WRITE $CHAR(13),"AVAILABILITY LISTING FOR: ",$EXTRACT(PRCP("IN"),1,20),?(80-$LENGTH(%)),%
- +2 SET %=""
- SET $PIECE(%,"-",81)=""
- +3 IF PRCPSUMM
- WRITE !?1,"*** ONLY SUMMARY OF ITEMS PRINTED ***",!,%
- QUIT
- +4 WRITE !,"DESCR",?15,"DESCRIPTION",?40,"MI",$JUSTIFY("UNIT/IS",14),?77,"KWZ",!,%
- +5 QUIT