- PRCPRAVL ;WISC/RFJ-availability list report (option, whse) ;9.9.97
- ;;5.1;IFCAP;;Oct 20, 2000
- ;Per VHA Directive 10-93-142, this routine should not be modified.
- D ^PRCPUSEL Q:'$G(PRCP("I"))
- I PRCP("DPTYPE")'="W" D PRIMARY^PRCPRAVP Q
- ;
- ; availability list for whse
- N ACCOUNT,PRCPEND,PRCPSORT,PRCPSTRT,PRCPSUMM,X
- K X S X(1)="The Availability Listing will display the current quantity and value of the inventory point items. The report will sort Warehouse inventory items by Account Code or NSN." D DISPLAY^PRCPUX2(40,79,.X)
- S PRCPSUMM=$$SUMMARY^PRCPURS0 I PRCPSUMM<0 Q
- I PRCPSUMM S PRCPSORT=1,(ACCOUNT(1),ACCOUNT(2),ACCOUNT(3),ACCOUNT(6),ACCOUNT(8))="" G DEVICE
- K X S X(1)="Select the type of Sort" W ! D DISPLAY^PRCPUX2(2,40,.X)
- S PRCPSORT=$$SORTBY^PRCPURS0 I 'PRCPSORT Q
- I PRCPSORT=1 K X S X(1)="Select the Account Codes to display" D DISPLAY^PRCPUX2(2,40,.X),ACCTSEL^PRCPURS0 I '$O(ACCOUNT(0)) Q
- I PRCPSORT=2 K X S X(1)="Select the range of NSNs to display" D DISPLAY^PRCPUX2(2,40,.X),NSNSEL^PRCPURS0 I '$D(PRCPSTRT) Q
- DEVICE W ! S %ZIS="Q" D ^%ZIS Q:POP I $D(IO("Q")) D D ^%ZTLOAD K IO("Q"),ZTSK Q
- . S ZTDESC="Warehouse Availability Listing",ZTRTN="DQ^PRCPRAVL"
- . S ZTSAVE("PRCP*")="",ZTSAVE("ACCOUNT*")="",ZTSAVE("ZTREQ")="@"
- W !!,"<*> please wait <*>"
- DQ ; queue starts here
- N %I,ACCT,ITEMDA,ITEMDATA,NOW,NSN,PAGE,PRCPFLAG,SALE,SCREEN,TOTINV,TOTNON,TOTSEL,X,Y
- K ^TMP($J,"PRCPRAVL")
- S ITEMDA=0 F S ITEMDA=$O(^PRCP(445,PRCP("I"),1,ITEMDA)) Q:'ITEMDA D
- . S NSN=$$NSN^PRCPUX1(ITEMDA),ACCT=$$ACCT1^PRCPUX1($E(NSN,1,4))
- . S:NSN="" NSN=" "
- . I PRCPSORT=1 S:$D(ACCOUNT(ACCT)) ^TMP($J,"PRCPRAVL",ACCT,NSN,ITEMDA)="" Q
- . I NSN]PRCPSTRT,PRCPEND]NSN S ^TMP($J,"PRCPRAVL",ACCT,NSN,ITEMDA)=""
- . I $E(NSN,1,$L(PRCPSTRT))=PRCPSTRT!($E(NSN,1,$L(PRCPEND))=PRCPEND) S ^TMP($J,"PRCPRAVL",ACCT,NSN,ITEMDA)=""
- ; print report
- D NOW^%DTC S Y=% D DD^%DT S NOW=Y,PAGE=1,SCREEN=$$SCRPAUSE^PRCPUREP U IO D H
- S ACCT=0 F S ACCT=$O(^TMP($J,"PRCPRAVL",ACCT)) Q:'ACCT!($G(PRCPFLAG)) D
- . I $Y>(IOSL-6) D:SCREEN P^PRCPUREP Q:$D(PRCPFLAG) D H
- . W:'PRCPSUMM !!?5,"ACCOUNT NUMBER: ",ACCT
- . S NSN="" F S NSN=$O(^TMP($J,"PRCPRAVL",ACCT,NSN)) Q:NSN=""!($G(PRCPFLAG)) S ITEMDA=0 F S ITEMDA=$O(^TMP($J,"PRCPRAVL",ACCT,NSN,ITEMDA)) Q:'ITEMDA!($G(PRCPFLAG)) D
- . . S ITEMDATA=$G(^PRCP(445,PRCP("I"),1,ITEMDA,0))
- . . W:'PRCPSUMM !!,$TR(NSN,"-"),?15,$E($$DESCR^PRCPUX1(PRCP("I"),ITEMDA),1,23),?39,"[",ITEMDA,"]",?48,$J($$UNIT^PRCPUX1(PRCP("I"),ITEMDA,"/"),8)
- . . W:'PRCPSUMM ?58,$E($$GROUPNM^PRCPEGRP(+$$GROUPDA^PRCPEGRP(PRCP("I"),ITEMDA)),1,20),?79,$S($P(ITEMDATA,"^",26)="Y":"*",1:"")
- . . W:'PRCPSUMM !,$J("ONHAND",8),$J("NONISS",8),$J("DUEIN",8),$J("DUEOUT",8),$J("REORDPT",8),$J("ISSMUL",8),$J("SELLCOST",10),$J("AVGCOST",10),$J("TOTVALUE",12)
- . . W:'PRCPSUMM !,$J(+$P(ITEMDATA,"^",7),8),$J(+$P(ITEMDATA,"^",19),8),$J($$GETIN^PRCPUDUE(PRCP("I"),ITEMDA),8),$J($$GETOUT^PRCPUDUE(PRCP("I"),ITEMDA),8),$J(+$P(ITEMDATA,"^",10),8)
- . . S %=$P($G(^PRC(441,ITEMDA,2,+$O(^PRC(440,"AC","S",0)),0)),"^",11)
- . . S SALE=$S($P(ITEMDATA,"^",15)>$P(ITEMDATA,"^",22):$P(ITEMDATA,"^",15),1:$P(ITEMDATA,"^",22))
- . . W:'PRCPSUMM $J(%,8),$J(SALE,10,3),$J($P(ITEMDATA,"^",22),10,3),$J($P(ITEMDATA,"^",27),12,2)
- . . S TOTINV(ACCT)=$G(TOTINV(ACCT))+$P(ITEMDATA,"^",27)
- . . S TOTSEL(ACCT)=$G(TOTSEL(ACCT))+$J(($P(ITEMDATA,"^",7)+$P(ITEMDATA,"^",19))*SALE,0,2)
- . . S TOTNON(ACCT)=$G(TOTNON(ACCT))+$J($P(ITEMDATA,"^",19)*$P(ITEMDATA,"^",22),0,2)
- . . 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-9) D:SCREEN P^PRCPUREP Q:$D(PRCPFLAG) D H
- W !?20,$J("ISSUE+NONISSUE",20),$J("ESTIMATED",20)
- W !?2,"TOTALS :",?20,$J("INVENTORY VALUE",20),$J("NONISSUABLE VALUE",20),$J("SELLING VALUE",20),!?2,"--------",?20,$J("---------------",20),$J("------------------",20),$J("-------------",20)
- S (TOTINV,TOTNON,TOTSEL)=0 F ACCT=1,2,3,6,8 D
- . W !?2,"ACCT ",ACCT," :",?20,$J($G(TOTINV(ACCT)),20,2),$J($G(TOTNON(ACCT)),20,2),$J($G(TOTSEL(ACCT)),20,2)
- . S TOTINV=TOTINV+$G(TOTINV(ACCT)),TOTNON=TOTNON+$G(TOTNON(ACCT)),TOTSEL=TOTSEL+$G(TOTSEL(ACCT))
- W !?2,"--------",?20,$J("---------------",20),$J("------------------",20),$J("-------------",20)
- W !?2,"TOTALS :",?20,$J(TOTINV,20,2),$J(TOTNON,20,2),$J(TOTSEL,20,2)
- D END^PRCPUREP
- Q D ^%ZISC K ^TMP($J,"PRCPRAVL")
- 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 !,"NSN",?15,"DESCRIPTION",?40,"MI",$J("UNIT/IS",14),?58,"GROUP CATEGORY",?77,"KWZ",!,%
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRCPRAVL 4842 printed Jan 18, 2025@03:15:46 Page 2
- PRCPRAVL ;WISC/RFJ-availability list report (option, whse) ;9.9.97
- +1 ;;5.1;IFCAP;;Oct 20, 2000
- +2 ;Per VHA Directive 10-93-142, this routine should not be modified.
- +3 DO ^PRCPUSEL
- if '$GET(PRCP("I"))
- QUIT
- +4 IF PRCP("DPTYPE")'="W"
- DO PRIMARY^PRCPRAVP
- QUIT
- +5 ;
- +6 ; availability list for whse
- +7 NEW ACCOUNT,PRCPEND,PRCPSORT,PRCPSTRT,PRCPSUMM,X
- +8 KILL X
- SET X(1)="The Availability Listing will display the current quantity and value of the inventory point items. The report will sort Warehouse inventory items by Account Code or NSN."
- DO DISPLAY^PRCPUX2(40,79,.X)
- +9 SET PRCPSUMM=$$SUMMARY^PRCPURS0
- IF PRCPSUMM<0
- QUIT
- +10 IF PRCPSUMM
- SET PRCPSORT=1
- SET (ACCOUNT(1),ACCOUNT(2),ACCOUNT(3),ACCOUNT(6),ACCOUNT(8))=""
- GOTO DEVICE
- +11 KILL X
- SET X(1)="Select the type of Sort"
- WRITE !
- DO DISPLAY^PRCPUX2(2,40,.X)
- +12 SET PRCPSORT=$$SORTBY^PRCPURS0
- IF 'PRCPSORT
- QUIT
- +13 IF PRCPSORT=1
- KILL X
- SET X(1)="Select the Account Codes to display"
- DO DISPLAY^PRCPUX2(2,40,.X)
- DO ACCTSEL^PRCPURS0
- IF '$ORDER(ACCOUNT(0))
- QUIT
- +14 IF PRCPSORT=2
- KILL X
- SET X(1)="Select the range of NSNs to display"
- DO DISPLAY^PRCPUX2(2,40,.X)
- DO NSNSEL^PRCPURS0
- IF '$DATA(PRCPSTRT)
- QUIT
- DEVICE WRITE !
- SET %ZIS="Q"
- DO ^%ZIS
- if POP
- QUIT
- IF $DATA(IO("Q"))
- Begin DoDot:1
- +1 SET ZTDESC="Warehouse Availability Listing"
- SET ZTRTN="DQ^PRCPRAVL"
- +2 SET ZTSAVE("PRCP*")=""
- SET ZTSAVE("ACCOUNT*")=""
- SET ZTSAVE("ZTREQ")="@"
- End DoDot:1
- DO ^%ZTLOAD
- KILL IO("Q"),ZTSK
- QUIT
- +3 WRITE !!,"<*> please wait <*>"
- DQ ; queue starts here
- +1 NEW %I,ACCT,ITEMDA,ITEMDATA,NOW,NSN,PAGE,PRCPFLAG,SALE,SCREEN,TOTINV,TOTNON,TOTSEL,X,Y
- +2 KILL ^TMP($JOB,"PRCPRAVL")
- +3 SET ITEMDA=0
- FOR
- SET ITEMDA=$ORDER(^PRCP(445,PRCP("I"),1,ITEMDA))
- if 'ITEMDA
- QUIT
- Begin DoDot:1
- +4 SET NSN=$$NSN^PRCPUX1(ITEMDA)
- SET ACCT=$$ACCT1^PRCPUX1($EXTRACT(NSN,1,4))
- +5 if NSN=""
- SET NSN=" "
- +6 IF PRCPSORT=1
- if $DATA(ACCOUNT(ACCT))
- SET ^TMP($JOB,"PRCPRAVL",ACCT,NSN,ITEMDA)=""
- QUIT
- +7 IF NSN]PRCPSTRT
- IF PRCPEND]NSN
- SET ^TMP($JOB,"PRCPRAVL",ACCT,NSN,ITEMDA)=""
- +8 IF $EXTRACT(NSN,1,$LENGTH(PRCPSTRT))=PRCPSTRT!($EXTRACT(NSN,1,$LENGTH(PRCPEND))=PRCPEND)
- SET ^TMP($JOB,"PRCPRAVL",ACCT,NSN,ITEMDA)=""
- End DoDot:1
- +9 ; print report
- +10 DO NOW^%DTC
- SET Y=%
- DO DD^%DT
- SET NOW=Y
- SET PAGE=1
- SET SCREEN=$$SCRPAUSE^PRCPUREP
- USE IO
- DO H
- +11 SET ACCT=0
- FOR
- SET ACCT=$ORDER(^TMP($JOB,"PRCPRAVL",ACCT))
- if 'ACCT!($GET(PRCPFLAG))
- QUIT
- Begin DoDot:1
- +12 IF $Y>(IOSL-6)
- if SCREEN
- DO P^PRCPUREP
- if $DATA(PRCPFLAG)
- QUIT
- DO H
- +13 if 'PRCPSUMM
- WRITE !!?5,"ACCOUNT NUMBER: ",ACCT
- +14 SET NSN=""
- FOR
- SET NSN=$ORDER(^TMP($JOB,"PRCPRAVL",ACCT,NSN))
- if NSN=""!($GET(PRCPFLAG))
- QUIT
- SET ITEMDA=0
- FOR
- SET ITEMDA=$ORDER(^TMP($JOB,"PRCPRAVL",ACCT,NSN,ITEMDA))
- if 'ITEMDA!($GET(PRCPFLAG))
- QUIT
- Begin DoDot:2
- +15 SET ITEMDATA=$GET(^PRCP(445,PRCP("I"),1,ITEMDA,0))
- +16 if 'PRCPSUMM
- WRITE !!,$TRANSLATE(NSN,"-"),?15,$EXTRACT($$DESCR^PRCPUX1(PRCP("I"),ITEMDA),1,23),?39,"[",ITEMDA,"]",?48,$JUSTIFY($$UNIT^PRCPUX1(PRCP("I"),ITEMDA,"/"),8)
- +17 if 'PRCPSUMM
- WRITE ?58,$EXTRACT($$GROUPNM^PRCPEGRP(+$$GROUPDA^PRCPEGRP(PRCP("I"),ITEMDA)),1,20),?79,$SELECT($PIECE(ITEMDATA,"^",26)="Y":"*",1:"")
- +18 if 'PRCPSUMM
- WRITE !,$JUSTIFY("ONHAND",8),$JUSTIFY("NONISS",8),$JUSTIFY("DUEIN",8),$JUSTIFY("DUEOUT",8),$JUSTIFY("REORDPT",8),$JUSTIFY("ISSMUL",8),$JUSTIFY("SELLCOST",10),$JUSTIFY("AVGCOST",10),$JUSTIFY("TOTVALUE",12)
- +19 if 'PRCPSUMM
- WRITE !,$JUSTIFY(+$PIECE(ITEMDATA,"^",7),8),$JUSTIFY(+$PIECE(ITEMDATA,"^",19),8),$JUSTIFY($$GETIN^PRCPUDUE(PRCP("I"),ITEMDA),8),$JUSTIFY($$GETOUT^PRCPUDUE(PRCP("I"),ITEMDA),8),$JUSTIFY(+$PIECE(ITEMDATA,"^",10),8)
- +20 SET %=$PIECE($GET(^PRC(441,ITEMDA,2,+$ORDER(^PRC(440,"AC","S",0)),0)),"^",11)
- +21 SET SALE=$SELECT($PIECE(ITEMDATA,"^",15)>$PIECE(ITEMDATA,"^",22):$PIECE(ITEMDATA,"^",15),1:$PIECE(ITEMDATA,"^",22))
- +22 if 'PRCPSUMM
- WRITE $JUSTIFY(%,8),$JUSTIFY(SALE,10,3),$JUSTIFY($PIECE(ITEMDATA,"^",22),10,3),$JUSTIFY($PIECE(ITEMDATA,"^",27),12,2)
- +23 SET TOTINV(ACCT)=$GET(TOTINV(ACCT))+$PIECE(ITEMDATA,"^",27)
- +24 SET TOTSEL(ACCT)=$GET(TOTSEL(ACCT))+$JUSTIFY(($PIECE(ITEMDATA,"^",7)+$PIECE(ITEMDATA,"^",19))*SALE,0,2)
- +25 SET TOTNON(ACCT)=$GET(TOTNON(ACCT))+$JUSTIFY($PIECE(ITEMDATA,"^",19)*$PIECE(ITEMDATA,"^",22),0,2)
- +26 IF $Y>(IOSL-6)
- if SCREEN
- DO P^PRCPUREP
- if $DATA(PRCPFLAG)
- QUIT
- DO H
- End DoDot:2
- +27 IF $GET(ZTQUEUED)
- IF $$S^%ZTLOAD
- SET PRCPFLAG=1
- WRITE !?10,"<<< TASKMANAGER JOB TERMINATED BY USER >>>"
- End DoDot:1
- +28 IF $GET(PRCPFLAG)
- DO Q
- QUIT
- +29 IF $Y>(IOSL-9)
- if SCREEN
- DO P^PRCPUREP
- if $DATA(PRCPFLAG)
- QUIT
- DO H
- +30 WRITE !?20,$JUSTIFY("ISSUE+NONISSUE",20),$JUSTIFY("ESTIMATED",20)
- +31 WRITE !?2,"TOTALS :",?20,$JUSTIFY("INVENTORY VALUE",20),$JUSTIFY("NONISSUABLE VALUE",20),$JUSTIFY("SELLING VALUE",20),!?2,"--------",?20,$JUSTIFY("---------------",20),$JUSTIFY("------------------",20),$JUSTIFY("-------------",20)
- +32 SET (TOTINV,TOTNON,TOTSEL)=0
- FOR ACCT=1,2,3,6,8
- Begin DoDot:1
- +33 WRITE !?2,"ACCT ",ACCT," :",?20,$JUSTIFY($GET(TOTINV(ACCT)),20,2),$JUSTIFY($GET(TOTNON(ACCT)),20,2),$JUSTIFY($GET(TOTSEL(ACCT)),20,2)
- +34 SET TOTINV=TOTINV+$GET(TOTINV(ACCT))
- SET TOTNON=TOTNON+$GET(TOTNON(ACCT))
- SET TOTSEL=TOTSEL+$GET(TOTSEL(ACCT))
- End DoDot:1
- +35 WRITE !?2,"--------",?20,$JUSTIFY("---------------",20),$JUSTIFY("------------------",20),$JUSTIFY("-------------",20)
- +36 WRITE !?2,"TOTALS :",?20,$JUSTIFY(TOTINV,20,2),$JUSTIFY(TOTNON,20,2),$JUSTIFY(TOTSEL,20,2)
- +37 DO END^PRCPUREP
- Q DO ^%ZISC
- KILL ^TMP($JOB,"PRCPRAVL")
- +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 !,"NSN",?15,"DESCRIPTION",?40,"MI",$JUSTIFY("UNIT/IS",14),?58,"GROUP CATEGORY",?77,"KWZ",!,%
- +5 QUIT