EMERGENCY Released PRC*5.1*200 SEQ #174 Extracted from mail message **KIDS**:PRC*5.1*200^ **INSTALL NAME** PRC*5.1*200 "BLD",7591,0) PRC*5.1*200^IFCAP^0^3170721^y "BLD",7591,1,0) ^^2^2^3170615^ "BLD",7591,1,1,0) 1. Keep Perpetual Inventory not working correctly for inventory "BLD",7591,1,2,0) distribution of items to the Secondary Inventory Point. "BLD",7591,4,0) ^9.64PA^^ "BLD",7591,6.3) 3 "BLD",7591,"ABPKG") n "BLD",7591,"KRN",0) ^9.67PA^779.2^20 "BLD",7591,"KRN",.4,0) .4 "BLD",7591,"KRN",.401,0) .401 "BLD",7591,"KRN",.402,0) .402 "BLD",7591,"KRN",.403,0) .403 "BLD",7591,"KRN",.5,0) .5 "BLD",7591,"KRN",.84,0) .84 "BLD",7591,"KRN",3.6,0) 3.6 "BLD",7591,"KRN",3.8,0) 3.8 "BLD",7591,"KRN",9.2,0) 9.2 "BLD",7591,"KRN",9.8,0) 9.8 "BLD",7591,"KRN",9.8,"NM",0) ^9.68A^1^1 "BLD",7591,"KRN",9.8,"NM",1,0) PRCPOPPP^^0^B15418168 "BLD",7591,"KRN",9.8,"NM","B","PRCPOPPP",1) "BLD",7591,"KRN",19,0) 19 "BLD",7591,"KRN",19.1,0) 19.1 "BLD",7591,"KRN",101,0) 101 "BLD",7591,"KRN",409.61,0) 409.61 "BLD",7591,"KRN",771,0) 771 "BLD",7591,"KRN",779.2,0) 779.2 "BLD",7591,"KRN",870,0) 870 "BLD",7591,"KRN",8989.51,0) 8989.51 "BLD",7591,"KRN",8989.52,0) 8989.52 "BLD",7591,"KRN",8994,0) 8994 "BLD",7591,"KRN","B",.4,.4) "BLD",7591,"KRN","B",.401,.401) "BLD",7591,"KRN","B",.402,.402) "BLD",7591,"KRN","B",.403,.403) "BLD",7591,"KRN","B",.5,.5) "BLD",7591,"KRN","B",.84,.84) "BLD",7591,"KRN","B",3.6,3.6) "BLD",7591,"KRN","B",3.8,3.8) "BLD",7591,"KRN","B",9.2,9.2) "BLD",7591,"KRN","B",9.8,9.8) "BLD",7591,"KRN","B",19,19) "BLD",7591,"KRN","B",19.1,19.1) "BLD",7591,"KRN","B",101,101) "BLD",7591,"KRN","B",409.61,409.61) "BLD",7591,"KRN","B",771,771) "BLD",7591,"KRN","B",779.2,779.2) "BLD",7591,"KRN","B",870,870) "BLD",7591,"KRN","B",8989.51,8989.51) "BLD",7591,"KRN","B",8989.52,8989.52) "BLD",7591,"KRN","B",8994,8994) "BLD",7591,"QDEF") ^^^^^^^^^^YES "BLD",7591,"QUES",0) ^9.62^^ "BLD",7591,"REQB",0) ^9.611^1^1 "BLD",7591,"REQB",1,0) PRC*5.1*33^2 "BLD",7591,"REQB","B","PRC*5.1*33",1) "MBREQ") 0 "PKG",455,-1) 1^1 "PKG",455,0) IFCAP^PRC^IFCAP System Files "PKG",455,20,0) ^9.402P^^ "PKG",455,22,0) ^9.49I^1^1 "PKG",455,22,1,0) 5.1^3001012^3001019^68 "PKG",455,22,1,"PAH",1,0) 200^3170721 "PKG",455,22,1,"PAH",1,1,0) ^^2^2^3170721 "PKG",455,22,1,"PAH",1,1,1,0) 1. Keep Perpetual Inventory not working correctly for inventory "PKG",455,22,1,"PAH",1,1,2,0) distribution of items to the Secondary Inventory Point. "QUES","XPF1",0) Y "QUES","XPF1","??") ^D REP^XPDH "QUES","XPF1","A") Shall I write over your |FLAG| File "QUES","XPF1","B") YES "QUES","XPF1","M") D XPF1^XPDIQ "QUES","XPF2",0) Y "QUES","XPF2","??") ^D DTA^XPDH "QUES","XPF2","A") Want my data |FLAG| yours "QUES","XPF2","B") YES "QUES","XPF2","M") D XPF2^XPDIQ "QUES","XPI1",0) YO "QUES","XPI1","??") ^D INHIBIT^XPDH "QUES","XPI1","A") Want KIDS to INHIBIT LOGONs during the install "QUES","XPI1","B") NO "QUES","XPI1","M") D XPI1^XPDIQ "QUES","XPM1",0) PO^VA(200,:EM "QUES","XPM1","??") ^D MG^XPDH "QUES","XPM1","A") Enter the Coordinator for Mail Group '|FLAG|' "QUES","XPM1","B") "QUES","XPM1","M") D XPM1^XPDIQ "QUES","XPO1",0) Y "QUES","XPO1","??") ^D MENU^XPDH "QUES","XPO1","A") Want KIDS to Rebuild Menu Trees Upon Completion of Install "QUES","XPO1","B") NO "QUES","XPO1","M") D XPO1^XPDIQ "QUES","XPZ1",0) Y "QUES","XPZ1","??") ^D OPT^XPDH "QUES","XPZ1","A") Want to DISABLE Scheduled Options, Menu Options, and Protocols "QUES","XPZ1","B") YES "QUES","XPZ1","M") D XPZ1^XPDIQ "QUES","XPZ2",0) Y "QUES","XPZ2","??") ^D RTN^XPDH "QUES","XPZ2","A") Want to MOVE routines to other CPUs "QUES","XPZ2","B") NO "QUES","XPZ2","M") D XPZ2^XPDIQ "RTN") 1 "RTN","PRCPOPPP") 0^1^B15418168^B13897532 "RTN","PRCPOPPP",1,0) PRCPOPPP ;WISC/RFJ/DWA-move item from prim to seco to patient ;27 Sep 93 "RTN","PRCPOPPP",2,0) ;;5.1;IFCAP;**4,33,200**;Oct 20, 2000;Build 3 "RTN","PRCPOPPP",3,0) ;Per VA Directive 6402, this routine should not be modified. "RTN","PRCPOPPP",4,0) Q "RTN","PRCPOPPP",5,0) ; "RTN","PRCPOPPP",6,0) ;PRC*5.1*200 Check when posting inventory distribution to "RTN","PRCPOPPP",7,0) ; secondary IP that the qty and cost are not "RTN","PRCPOPPP",8,0) ; affected when Perpetual flag = "N" "RTN","PRCPOPPP",9,0) ; "RTN","PRCPOPPP",10,0) SALE(PRCPPRIM,ITEMDA,TRANORDR,PRCPOPPP) ; post item for primary sale "RTN","PRCPOPPP",11,0) ; tranordr=transaction register # "RTN","PRCPOPPP",12,0) ; prcpoppp("qty") = qty to sale (include minus for sale) "RTN","PRCPOPPP",13,0) ; prcpoppp("invval") = inv value sold (include minus for sale) "RTN","PRCPOPPP",14,0) ; prcpoppp("orderda")= ien of ordernumber in 445.3 (used for type) "RTN","PRCPOPPP",15,0) ; prcpoppp("otherpt") = inv pt sold to "RTN","PRCPOPPP",16,0) ; prcpoppp("dueout") = dueout qty to add (- to subtract) "RTN","PRCPOPPP",17,0) ; prcpoppp("reason") = 0:reason for transaction register "RTN","PRCPOPPP",18,0) ; prcpoppp("noinvpt") = set to 1 to prevent from updating invpt "RTN","PRCPOPPP",19,0) ; locks to inventory pt prcpprim need to be applied before entry "RTN","PRCPOPPP",20,0) ; "RTN","PRCPOPPP",21,0) ; distribution costs "RTN","PRCPOPPP",22,0) N COSTCNTR,TYPE "RTN","PRCPOPPP",23,0) ; use costcenter for primary since secondaries do not have costcenters "RTN","PRCPOPPP",24,0) S COSTCNTR=$P($G(^PRCP(445,PRCPPRIM,0)),"^",7) "RTN","PRCPOPPP",25,0) I COSTCNTR,$G(PRCPOPPP("OTHERPT")) D COSTCNTR^PRCPUCC(PRCPOPPP("OTHERPT"),PRCPPRIM,COSTCNTR,-PRCPOPPP("INVVAL")) "RTN","PRCPOPPP",26,0) ; "RTN","PRCPOPPP",27,0) ; usage "RTN","PRCPOPPP",28,0) D ADDUSAG^PRCPUSAG(PRCPPRIM,ITEMDA,-PRCPOPPP("QTY"),-PRCPOPPP("INVVAL")) "RTN","PRCPOPPP",29,0) ; "RTN","PRCPOPPP",30,0) ; if prcpoppp("noinvpt"), do not update inventory point "RTN","PRCPOPPP",31,0) I $G(PRCPOPPP("NOINVPT")) Q "RTN","PRCPOPPP",32,0) ; "RTN","PRCPOPPP",33,0) ; update begin balance, inventory point, transaction register "RTN","PRCPOPPP",34,0) S TYPE=$P($G(^PRCP(445.3,+$G(PRCPOPPP("ORDERDA")),0)),"^",8) I TYPE="" S TYPE="R" "RTN","PRCPOPPP",35,0) D INVPT(PRCPPRIM,ITEMDA,TYPE,TRANORDR,.PRCPOPPP) "RTN","PRCPOPPP",36,0) Q "RTN","PRCPOPPP",37,0) ; "RTN","PRCPOPPP",38,0) ; "RTN","PRCPOPPP",39,0) RECEIPT(PRCPSECO,ITEMDA,TRANORDR,PRCPOPPP) ; receive items "RTN","PRCPOPPP",40,0) ; tranordr=transaction register # "RTN","PRCPOPPP",41,0) ; prcpoppp("qty") = qty to receive "RTN","PRCPOPPP",42,0) ; prcpoppp("invval") = inv value received "RTN","PRCPOPPP",43,0) ; prcpoppp("otherpt") = inv pt received from "RTN","PRCPOPPP",44,0) ; prcpoppp("duein") = duein qty to add (- to subtract) "RTN","PRCPOPPP",45,0) ; prcpoppp("reason") = 0:reason for transaction register "RTN","PRCPOPPP",46,0) ; for patient distributions: "RTN","PRCPOPPP",47,0) ; prcpoppp("prcpptda") = ptr to file 446.1 (patient distribution) "RTN","PRCPOPPP",48,0) ; locks to inventory pt prcpseco need to be applied before entry "RTN","PRCPOPPP",49,0) ; "RTN","PRCPOPPP",50,0) ; receipt history "RTN","PRCPOPPP",51,0) D RECEIPTS^PRCPUSAG(PRCPSECO,ITEMDA,PRCPOPPP("QTY")) "RTN","PRCPOPPP",52,0) ; "RTN","PRCPOPPP",53,0) ; update inventory point "RTN","PRCPOPPP",54,0) D INVPT(PRCPSECO,ITEMDA,"RC",TRANORDR,.PRCPOPPP) "RTN","PRCPOPPP",55,0) ; "RTN","PRCPOPPP",56,0) ; if no patient quit "RTN","PRCPOPPP",57,0) I '$G(PRCPOPPP("PRCPPTDA")) Q "RTN","PRCPOPPP",58,0) ; "RTN","PRCPOPPP",59,0) ; sale to patient "RTN","PRCPOPPP",60,0) ; "RTN","PRCPOPPP",61,0) ; usage "RTN","PRCPOPPP",62,0) D ADDUSAG^PRCPUSAG(PRCPSECO,ITEMDA,PRCPOPPP("QTY"),PRCPOPPP("INVVAL")) "RTN","PRCPOPPP",63,0) ; "RTN","PRCPOPPP",64,0) ; take out of inventory point "RTN","PRCPOPPP",65,0) N COST,QTY,Y "RTN","PRCPOPPP",66,0) S QTY=PRCPOPPP("QTY"),COST=PRCPOPPP("INVVAL") "RTN","PRCPOPPP",67,0) S PRCPOPPP("QTY")=-QTY,(PRCPOPPP("INVVAL"),PRCPOPPP("SELVAL"))=-COST "RTN","PRCPOPPP",68,0) K PRCPOPPP("OTHERPT"),PRCPOPPP("DUEIN") "RTN","PRCPOPPP",69,0) S Y=PRCPPTDA D DD^%DT "RTN","PRCPOPPP",70,0) S PRCPOPPP("REASON")="0:Distribution to patient ("_Y_")" "RTN","PRCPOPPP",71,0) D INVPT(PRCPSECO,ITEMDA,"R",TRANORDR,.PRCPOPPP) "RTN","PRCPOPPP",72,0) ; "RTN","PRCPOPPP",73,0) ; distribute to patient "RTN","PRCPOPPP",74,0) D DISTITEM^PRCPUPAT(PRCPPTDA,ITEMDA,QTY,COST) "RTN","PRCPOPPP",75,0) Q "RTN","PRCPOPPP",76,0) ; "RTN","PRCPOPPP",77,0) ; "RTN","PRCPOPPP",78,0) INVPT(PRCPINPT,ITEMDA,TRANTYPE,TRANORDR,PRCPOPPP) ; update inventory point data "RTN","PRCPOPPP",79,0) ; trantype=type of transaction; tranordr=transaction register # "RTN","PRCPOPPP",80,0) ; prcpoppp("qty") = qty to add to inventory point "RTN","PRCPOPPP",81,0) ; prcpoppp("invval") = value to add to inventory point "RTN","PRCPOPPP",82,0) ; prcpoppp("otherpt") = inv pt sold to (for transaction register) "RTN","PRCPOPPP",83,0) ; prcpoppp("dueout") = qty to add to dueout "RTN","PRCPOPPP",84,0) ; prcpoppp("duein") = qty to add to duein "RTN","PRCPOPPP",85,0) ; prcpoppp("reason") = 0:reason for transaction register "RTN","PRCPOPPP",86,0) ; locks to inventory pt prcpinpt need to be applied before entry "RTN","PRCPOPPP",87,0) ; "RTN","PRCPOPPP",88,0) N ITEMDATA,QUANTITY "RTN","PRCPOPPP",89,0) I $P(^PRCP(445,PRCPINPT,0),"^",2)="N",$P(^PRCP(445,PRCPINPT,0),"^",3)="S" S PRCPOPPP("QTY")=0,PRCPOPPP("INVVAL")=0 ;PRC*5.1*200 "RTN","PRCPOPPP",90,0) S ITEMDATA=$G(^PRCP(445,PRCPINPT,1,ITEMDA,0)) I ITEMDATA="" Q "RTN","PRCPOPPP",91,0) ; "RTN","PRCPOPPP",92,0) ; update beginning balance "RTN","PRCPOPPP",93,0) I '$D(^PRCP(445.1,PRCPINPT,1,ITEMDA,1,$E(DT,1,5),0)) D BALANCE^PRCPUBAL(PRCPINPT,ITEMDA,$E(DT,1,5)) "RTN","PRCPOPPP",94,0) ; "RTN","PRCPOPPP",95,0) ; make sure inventory value has been set to qty*unitcost "RTN","PRCPOPPP",96,0) I '$P(ITEMDATA,"^",27) S $P(ITEMDATA,"^",27)=$J($P(ITEMDATA,"^",7)*$P(ITEMDATA,"^",22),0,2) "RTN","PRCPOPPP",97,0) S $P(ITEMDATA,"^",7)=$P(ITEMDATA,"^",7)+PRCPOPPP("QTY") "RTN","PRCPOPPP",98,0) S $P(ITEMDATA,"^",27)=$P(ITEMDATA,"^",27)+PRCPOPPP("INVVAL") "RTN","PRCPOPPP",99,0) ; "RTN","PRCPOPPP",100,0) ; update average cost "RTN","PRCPOPPP",101,0) S $P(ITEMDATA,"^",22)=0,QUANTITY=$P(ITEMDATA,"^",7)+$P(ITEMDATA,"^",19) "RTN","PRCPOPPP",102,0) I QUANTITY>0 S $P(ITEMDATA,"^",22)=$J($P(ITEMDATA,"^",27)/QUANTITY,0,3) I $P(ITEMDATA,"^",22)'>0 S $P(ITEMDATA,"^",22)=0 "RTN","PRCPOPPP",103,0) S:TRANTYPE="RC" $P(ITEMDATA,"^",3)=DT "RTN","PRCPOPPP",104,0) S ^PRCP(445,PRCPINPT,1,ITEMDA,0)=ITEMDATA "RTN","PRCPOPPP",105,0) ; "RTN","PRCPOPPP",106,0) ; update dueout and duein "RTN","PRCPOPPP",107,0) I $G(PRCPOPPP("DUEOUT"))<0 D SETOUT^PRCPUDUE(PRCPINPT,ITEMDA,PRCPOPPP("DUEOUT")) "RTN","PRCPOPPP",108,0) I $G(PRCPOPPP("DUEIN"))<0 D SETIN^PRCPUDUE(PRCPINPT,ITEMDA,PRCPOPPP("DUEIN")) "RTN","PRCPOPPP",109,0) ; "RTN","PRCPOPPP",110,0) ; "RTN","PRCPOPPP",111,0) ; transaction register "RTN","PRCPOPPP",112,0) S PRCPOPPP("SELVAL")=PRCPOPPP("INVVAL") "RTN","PRCPOPPP",113,0) I TRANORDR D ADDTRAN^PRCPUTRX(PRCPINPT,ITEMDA,TRANTYPE,TRANORDR,.PRCPOPPP) "RTN","PRCPOPPP",114,0) Q "VER") 8.0^22.0 "BLD",7591,6) ^174 **END** **END**