Released PRC*5.1*130 SEQ #110 Extracted from mail message **KIDS**:PRC*5.1*130^ **INSTALL NAME** PRC*5.1*130 "BLD",5921,0) PRC*5.1*130^IFCAP^0^3090708^y "BLD",5921,1,0) ^^2^2^3090522^^ "BLD",5921,1,1,0) This patch introduces enhancements to facilitate monitoring of "BLD",5921,1,2,0) 1358 usage. "BLD",5921,4,0) ^9.64PA^^ "BLD",5921,6.3) 25 "BLD",5921,"ABPKG") n "BLD",5921,"INID") ^y "BLD",5921,"INIT") PRCH130 "BLD",5921,"KRN",0) ^9.67PA^779.2^20 "BLD",5921,"KRN",.4,0) .4 "BLD",5921,"KRN",.4,"NM",0) ^9.68A^25^25 "BLD",5921,"KRN",.4,"NM",1,0) PRC 1358 SEPARATION VIOL FILE #410^410^0 "BLD",5921,"KRN",.4,"NM",2,0) PRC 1358 MISSING FIELDS FILE #410^410^0 "BLD",5921,"KRN",.4,"NM",3,0) PRCHLO410-04_VALIDATE FILE #410^410^0 "BLD",5921,"KRN",.4,"NM",4,0) PRCHLO410_HDR_VALIDATE FILE #410^410^0 "BLD",5921,"KRN",.4,"NM",5,0) PRCHLO424-1_VALIDATE FILE #424.1^424.1^0 "BLD",5921,"KRN",.4,"NM",6,0) PRCHLO424_VALIDATE FILE #424^424^0 "BLD",5921,"KRN",.4,"NM",7,0) PRCHLO442_2237_VALIDATE FILE #442^442^0 "BLD",5921,"KRN",.4,"NM",8,0) PRCHLO442_AMENDMENT_VALIDATE FILE #442^442^0 "BLD",5921,"KRN",.4,"NM",9,0) PRCHLO442_AMEND_CHG_VALIDATE FILE #442^442^0 "BLD",5921,"KRN",.4,"NM",10,0) PRCHLO442_AMEND_DESCR1ST_VALID FILE #442^442^0 "BLD",5921,"KRN",.4,"NM",11,0) PRCHLO442_BOC_VALIDATE FILE #442^442^0 "BLD",5921,"KRN",.4,"NM",12,0) PRCHLO442_BREAKOUT_C_VALIDATE FILE #442^442^0 "BLD",5921,"KRN",.4,"NM",13,0) PRCHLO442_COMMENTS1ST_VALIDATE FILE #442^442^0 "BLD",5921,"KRN",.4,"NM",14,0) PRCHLO442_DISCOUNT_VALIDATE FILE #442^442^0 "BLD",5921,"KRN",.4,"NM",15,0) PRCHLO442_HDR_VALIDATE FILE #442^442^0 "BLD",5921,"KRN",.4,"NM",16,0) PRCHLO442_ITEM_DESC1ST_VALID FILE #442^442^0 "BLD",5921,"KRN",.4,"NM",17,0) PRCHLO442_ITEM_INVPT_VALIDATE FILE #442^442^0 "BLD",5921,"KRN",.4,"NM",18,0) PRCHLO442_ITEM_RECV_VALIDATE FILE #442^442^0 "BLD",5921,"KRN",.4,"NM",19,0) PRCHLO442_LINEITEM_VALIDATE FILE #442^442^0 "BLD",5921,"KRN",.4,"NM",20,0) PRCHLO442_OBLIG_VALIDATE FILE #442^442^0 "BLD",5921,"KRN",.4,"NM",21,0) PRCHLO442_PARTIAL_VALIDATE FILE #442^442^0 "BLD",5921,"KRN",.4,"NM",22,0) PRCHLO442_PO_AMT_VALIDATE FILE #442^442^0 "BLD",5921,"KRN",.4,"NM",23,0) PRCHLO442_PROMPT_PAY_VALIDATE FILE #442^442^0 "BLD",5921,"KRN",.4,"NM",24,0) PRCHLO442_PURCH_METH_VALIDATE FILE #442^442^0 "BLD",5921,"KRN",.4,"NM",25,0) PRCHLO442_REMARKS_1ST_VALIDATE FILE #442^442^0 "BLD",5921,"KRN",.4,"NM","B","PRC 1358 MISSING FIELDS FILE #410",2) "BLD",5921,"KRN",.4,"NM","B","PRC 1358 SEPARATION VIOL FILE #410",1) "BLD",5921,"KRN",.4,"NM","B","PRCHLO410-04_VALIDATE FILE #410",3) "BLD",5921,"KRN",.4,"NM","B","PRCHLO410_HDR_VALIDATE FILE #410",4) "BLD",5921,"KRN",.4,"NM","B","PRCHLO424-1_VALIDATE FILE #424.1",5) "BLD",5921,"KRN",.4,"NM","B","PRCHLO424_VALIDATE FILE #424",6) "BLD",5921,"KRN",.4,"NM","B","PRCHLO442_2237_VALIDATE FILE #442",7) "BLD",5921,"KRN",.4,"NM","B","PRCHLO442_AMENDMENT_VALIDATE FILE #442",8) "BLD",5921,"KRN",.4,"NM","B","PRCHLO442_AMEND_CHG_VALIDATE FILE #442",9) "BLD",5921,"KRN",.4,"NM","B","PRCHLO442_AMEND_DESCR1ST_VALID FILE #442",10) "BLD",5921,"KRN",.4,"NM","B","PRCHLO442_BOC_VALIDATE FILE #442",11) "BLD",5921,"KRN",.4,"NM","B","PRCHLO442_BREAKOUT_C_VALIDATE FILE #442",12) "BLD",5921,"KRN",.4,"NM","B","PRCHLO442_COMMENTS1ST_VALIDATE FILE #442",13) "BLD",5921,"KRN",.4,"NM","B","PRCHLO442_DISCOUNT_VALIDATE FILE #442",14) "BLD",5921,"KRN",.4,"NM","B","PRCHLO442_HDR_VALIDATE FILE #442",15) "BLD",5921,"KRN",.4,"NM","B","PRCHLO442_ITEM_DESC1ST_VALID FILE #442",16) "BLD",5921,"KRN",.4,"NM","B","PRCHLO442_ITEM_INVPT_VALIDATE FILE #442",17) "BLD",5921,"KRN",.4,"NM","B","PRCHLO442_ITEM_RECV_VALIDATE FILE #442",18) "BLD",5921,"KRN",.4,"NM","B","PRCHLO442_LINEITEM_VALIDATE FILE #442",19) "BLD",5921,"KRN",.4,"NM","B","PRCHLO442_OBLIG_VALIDATE FILE #442",20) "BLD",5921,"KRN",.4,"NM","B","PRCHLO442_PARTIAL_VALIDATE FILE #442",21) "BLD",5921,"KRN",.4,"NM","B","PRCHLO442_PO_AMT_VALIDATE FILE #442",22) "BLD",5921,"KRN",.4,"NM","B","PRCHLO442_PROMPT_PAY_VALIDATE FILE #442",23) "BLD",5921,"KRN",.4,"NM","B","PRCHLO442_PURCH_METH_VALIDATE FILE #442",24) "BLD",5921,"KRN",.4,"NM","B","PRCHLO442_REMARKS_1ST_VALIDATE FILE #442",25) "BLD",5921,"KRN",.401,0) .401 "BLD",5921,"KRN",.401,"NM",0) ^9.68A^2^2 "BLD",5921,"KRN",.401,"NM",1,0) PRC SEPARATION VIOLATE FILE #410^410^0 "BLD",5921,"KRN",.401,"NM",2,0) PRC MISSING 1358 FIELDS FILE #410^410^0 "BLD",5921,"KRN",.401,"NM","B","PRC MISSING 1358 FIELDS FILE #410",2) "BLD",5921,"KRN",.401,"NM","B","PRC SEPARATION VIOLATE FILE #410",1) "BLD",5921,"KRN",.402,0) .402 "BLD",5921,"KRN",.403,0) .403 "BLD",5921,"KRN",.5,0) .5 "BLD",5921,"KRN",.84,0) .84 "BLD",5921,"KRN",3.6,0) 3.6 "BLD",5921,"KRN",3.8,0) 3.8 "BLD",5921,"KRN",3.8,"NM",0) ^9.68A^1^1 "BLD",5921,"KRN",3.8,"NM",1,0) PRC 1358 MONITORS^^0 "BLD",5921,"KRN",3.8,"NM","B","PRC 1358 MONITORS",1) "BLD",5921,"KRN",9.2,0) 9.2 "BLD",5921,"KRN",9.8,0) 9.8 "BLD",5921,"KRN",9.8,"NM",0) ^9.68A^15^13 "BLD",5921,"KRN",9.8,"NM",1,0) PRCFFU2^^0^B8191248 "BLD",5921,"KRN",9.8,"NM",2,0) PRCFFU8^^0^B12574203 "BLD",5921,"KRN",9.8,"NM",3,0) PRCHLO^^0^B11530843 "BLD",5921,"KRN",9.8,"NM",4,0) PRCHLO1^^0^B60133725 "BLD",5921,"KRN",9.8,"NM",5,0) PRCHLO1A^^0^B77634009 "BLD",5921,"KRN",9.8,"NM",7,0) PRCHLO2A^^0^B28866192 "BLD",5921,"KRN",9.8,"NM",8,0) PRCHLO3^^0^B150252555 "BLD",5921,"KRN",9.8,"NM",9,0) PRCHLO4^^0^B120154139 "BLD",5921,"KRN",9.8,"NM",10,0) PRCHLO4A^^0^B72350733 "BLD",5921,"KRN",9.8,"NM",12,0) PRCPLO4^^0^B69580377 "BLD",5921,"KRN",9.8,"NM",13,0) PRCHLO6^^0^B122486114 "BLD",5921,"KRN",9.8,"NM",14,0) PRCH130^^0^B4880900 "BLD",5921,"KRN",9.8,"NM",15,0) PRC1358C^^0^B4910186 "BLD",5921,"KRN",9.8,"NM","B","PRC1358C",15) "BLD",5921,"KRN",9.8,"NM","B","PRCFFU2",1) "BLD",5921,"KRN",9.8,"NM","B","PRCFFU8",2) "BLD",5921,"KRN",9.8,"NM","B","PRCH130",14) "BLD",5921,"KRN",9.8,"NM","B","PRCHLO",3) "BLD",5921,"KRN",9.8,"NM","B","PRCHLO1",4) "BLD",5921,"KRN",9.8,"NM","B","PRCHLO1A",5) "BLD",5921,"KRN",9.8,"NM","B","PRCHLO2A",7) "BLD",5921,"KRN",9.8,"NM","B","PRCHLO3",8) "BLD",5921,"KRN",9.8,"NM","B","PRCHLO4",9) "BLD",5921,"KRN",9.8,"NM","B","PRCHLO4A",10) "BLD",5921,"KRN",9.8,"NM","B","PRCHLO6",13) "BLD",5921,"KRN",9.8,"NM","B","PRCPLO4",12) "BLD",5921,"KRN",19,0) 19 "BLD",5921,"KRN",19,"NM",0) ^9.68A^31^30 "BLD",5921,"KRN",19,"NM",2,0) PRCHUSER COORDINATOR^^2 "BLD",5921,"KRN",19,"NM",3,0) PRC 1358 COMPLIANCE REPORTS^^0 "BLD",5921,"KRN",19,"NM",4,0) PRC 1358 MISSING FIELDS^^0 "BLD",5921,"KRN",19,"NM",5,0) PRC 1358 SEPARATION VIOL^^0 "BLD",5921,"KRN",19,"NM",6,0) PRC 1358 MONITORING^^0 "BLD",5921,"KRN",19,"NM",7,0) PRCPLO CLO MENU^^2 "BLD",5921,"KRN",19,"NM",8,0) PRCHLO CLRS VALIDATION^^0 "BLD",5921,"KRN",19,"NM",9,0) PRCHLO 1358 AUTHORIZATION DET^^0 "BLD",5921,"KRN",19,"NM",10,0) PRCHLO 1358 DAILY RECORD^^0 "BLD",5921,"KRN",19,"NM",11,0) PRCHLO AMENDMENT DESCRIPTION^^0 "BLD",5921,"KRN",19,"NM",12,0) PRCHLO CONTROL POINT ACTIVIT^^0 "BLD",5921,"KRN",19,"NM",13,0) PRCHLO PO 2237 DATA^^0 "BLD",5921,"KRN",19,"NM",14,0) PRCHLO PO AMENDMENT^^0 "BLD",5921,"KRN",19,"NM",15,0) PRCHLO PO AMOUNT^^0 "BLD",5921,"KRN",19,"NM",16,0) PRCHLO PO AMOUNT BREAKOUT CODE^^0 "BLD",5921,"KRN",19,"NM",17,0) PRCHLO PO BOC DATA^^0 "BLD",5921,"KRN",19,"NM",18,0) PRCHLO PO CHANGES AMENDMENT^^0 "BLD",5921,"KRN",19,"NM",19,0) PRCHLO PO COMMENTS^^0 "BLD",5921,"KRN",19,"NM",20,0) PRCHLO PO DISCOUNT DATA^^0 "BLD",5921,"KRN",19,"NM",21,0) PRCHLO PO ITEM DATA^^0 "BLD",5921,"KRN",19,"NM",22,0) PRCHLO PO ITEM DATE RECEIVED^^0 "BLD",5921,"KRN",19,"NM",23,0) PRCHLO PO ITEM DESCRIPTION^^0 "BLD",5921,"KRN",19,"NM",24,0) PRCHLO PO ITEM INVENTORY POINT^^0 "BLD",5921,"KRN",19,"NM",25,0) PRCHLO PO MASTER DATA^^0 "BLD",5921,"KRN",19,"NM",26,0) PRCHLO PO METHOD OF PURCHASE^^0 "BLD",5921,"KRN",19,"NM",27,0) PRCHLO PO OBLIGATION DATA^^0 "BLD",5921,"KRN",19,"NM",28,0) PRCHLO PO PARTIAL DATA^^0 "BLD",5921,"KRN",19,"NM",29,0) PRCHLO PO PROMPT PAYMENT TERMS^^0 "BLD",5921,"KRN",19,"NM",30,0) PRCHLO PO REMARKS^^0 "BLD",5921,"KRN",19,"NM",31,0) PRCHLO SUBCONTROL POINT^^0 "BLD",5921,"KRN",19,"NM","B","PRC 1358 COMPLIANCE REPORTS",3) "BLD",5921,"KRN",19,"NM","B","PRC 1358 MISSING FIELDS",4) "BLD",5921,"KRN",19,"NM","B","PRC 1358 MONITORING",6) "BLD",5921,"KRN",19,"NM","B","PRC 1358 SEPARATION VIOL",5) "BLD",5921,"KRN",19,"NM","B","PRCHLO 1358 AUTHORIZATION DET",9) "BLD",5921,"KRN",19,"NM","B","PRCHLO 1358 DAILY RECORD",10) "BLD",5921,"KRN",19,"NM","B","PRCHLO AMENDMENT DESCRIPTION",11) "BLD",5921,"KRN",19,"NM","B","PRCHLO CLRS VALIDATION",8) "BLD",5921,"KRN",19,"NM","B","PRCHLO CONTROL POINT ACTIVIT",12) "BLD",5921,"KRN",19,"NM","B","PRCHLO PO 2237 DATA",13) "BLD",5921,"KRN",19,"NM","B","PRCHLO PO AMENDMENT",14) "BLD",5921,"KRN",19,"NM","B","PRCHLO PO AMOUNT",15) "BLD",5921,"KRN",19,"NM","B","PRCHLO PO AMOUNT BREAKOUT CODE",16) "BLD",5921,"KRN",19,"NM","B","PRCHLO PO BOC DATA",17) "BLD",5921,"KRN",19,"NM","B","PRCHLO PO CHANGES AMENDMENT",18) "BLD",5921,"KRN",19,"NM","B","PRCHLO PO COMMENTS",19) "BLD",5921,"KRN",19,"NM","B","PRCHLO PO DISCOUNT DATA",20) "BLD",5921,"KRN",19,"NM","B","PRCHLO PO ITEM DATA",21) "BLD",5921,"KRN",19,"NM","B","PRCHLO PO ITEM DATE RECEIVED",22) "BLD",5921,"KRN",19,"NM","B","PRCHLO PO ITEM DESCRIPTION",23) "BLD",5921,"KRN",19,"NM","B","PRCHLO PO ITEM INVENTORY POINT",24) "BLD",5921,"KRN",19,"NM","B","PRCHLO PO MASTER DATA",25) "BLD",5921,"KRN",19,"NM","B","PRCHLO PO METHOD OF PURCHASE",26) "BLD",5921,"KRN",19,"NM","B","PRCHLO PO OBLIGATION DATA",27) "BLD",5921,"KRN",19,"NM","B","PRCHLO PO PARTIAL DATA",28) "BLD",5921,"KRN",19,"NM","B","PRCHLO PO PROMPT PAYMENT TERMS",29) "BLD",5921,"KRN",19,"NM","B","PRCHLO PO REMARKS",30) "BLD",5921,"KRN",19,"NM","B","PRCHLO SUBCONTROL POINT",31) "BLD",5921,"KRN",19,"NM","B","PRCHUSER COORDINATOR",2) "BLD",5921,"KRN",19,"NM","B","PRCPLO CLO MENU",7) "BLD",5921,"KRN",19.1,0) 19.1 "BLD",5921,"KRN",101,0) 101 "BLD",5921,"KRN",409.61,0) 409.61 "BLD",5921,"KRN",771,0) 771 "BLD",5921,"KRN",779.2,0) 779.2 "BLD",5921,"KRN",870,0) 870 "BLD",5921,"KRN",8989.51,0) 8989.51 "BLD",5921,"KRN",8989.51,"NM",0) ^9.68A^3^3 "BLD",5921,"KRN",8989.51,"NM",1,0) PRCPLO PASSWORD^^0 "BLD",5921,"KRN",8989.51,"NM",2,0) PRCPLO REGIONAL ACQ CENTER^^0 "BLD",5921,"KRN",8989.51,"NM",3,0) PRCPLO USER NAME^^0 "BLD",5921,"KRN",8989.51,"NM","B","PRCPLO PASSWORD",1) "BLD",5921,"KRN",8989.51,"NM","B","PRCPLO REGIONAL ACQ CENTER",2) "BLD",5921,"KRN",8989.51,"NM","B","PRCPLO USER NAME",3) "BLD",5921,"KRN",8989.52,0) 8989.52 "BLD",5921,"KRN",8989.52,"NM",0) ^9.68A^^ "BLD",5921,"KRN",8994,0) 8994 "BLD",5921,"KRN","B",.4,.4) "BLD",5921,"KRN","B",.401,.401) "BLD",5921,"KRN","B",.402,.402) "BLD",5921,"KRN","B",.403,.403) "BLD",5921,"KRN","B",.5,.5) "BLD",5921,"KRN","B",.84,.84) "BLD",5921,"KRN","B",3.6,3.6) "BLD",5921,"KRN","B",3.8,3.8) "BLD",5921,"KRN","B",9.2,9.2) "BLD",5921,"KRN","B",9.8,9.8) "BLD",5921,"KRN","B",19,19) "BLD",5921,"KRN","B",19.1,19.1) "BLD",5921,"KRN","B",101,101) "BLD",5921,"KRN","B",409.61,409.61) "BLD",5921,"KRN","B",771,771) "BLD",5921,"KRN","B",779.2,779.2) "BLD",5921,"KRN","B",870,870) "BLD",5921,"KRN","B",8989.51,8989.51) "BLD",5921,"KRN","B",8989.52,8989.52) "BLD",5921,"KRN","B",8994,8994) "BLD",5921,"QUES",0) ^9.62^^ "BLD",5921,"REQB",0) ^9.611^^0 "INIT") PRCH130 "KRN",.4,2772,-1) 0^6 "KRN",.4,2772,0) PRCHLO424_VALIDATE^3090426.2334^@^424^^@^3090511 "KRN",.4,2772,"F",1) "POIDNUM: ";C1;""~S DIP(1)=$S($D(^PRC(424,D0,0)):^(0),1:"") S X=$P(DIP(1),U,2),X=X W X K DIP;X;"";Z;"INTERNAL(#.02)"~"PO#: ";C40;""~.02;X;""~ "KRN",.4,2772,"F",2) -442,^PRC(442,^^S I(0,0)=D0 S DIP(1)=$S($D(^PRC(424,D0,0)):^(0),1:"") S X=$P(DIP(1),U,2),X=X S D(0)=+X;Z;".02:"~-442,"P.O. DATE: ";C1;""~ "KRN",.4,2772,"F",3) -442,S DIP(101)=$S($D(^PRC(442,D0,1)):^(1),1:"") S X=$P(DIP(101),U,15),X=$P(X,".",1) S Y=X D DT K DIP;X;"";d;L18;Z;"DATE(#.1)"~-442,"STATION#: ";C40;""~ "KRN",.4,2772,"F",4) -442,S DIP(101)=$S($D(^PRC(442,D0,0)):^(0),1:"") S X=$P(DIP(101),U,1),DIP(102)=$G(X) S X="-",X=$P(DIP(102),X) W X K DIP;X;"";Z;"$P(#.01,"-")"~ "KRN",.4,2772,"F",5) "AUTHORIZATION #: ";C1;""~.01;X;""~"TRANSACTION TYPE: ";C40;""~.03;X;""~"LIQUIDATION AMT: ";C1;""~.04;X;""~"AUTHORIZTION BAL: ";C40;""~.05;X;""~ "KRN",.4,2772,"F",6) "OBLIGATION AMT: ";C1;""~.06;X;""~"DATE/TIME: ";C40;""~ "KRN",.4,2772,"F",7) S DIP(1)=$S($D(^PRC(424,D0,0)):^(0),1:"") S X=$P(DIP(1),U,7),X=$P(X,".",1) S Y=X D DT K DIP;X;"";d;L18;Z;"DATE(DATE/TIME)"~"USER DUZ: ";C1;""~ "KRN",.4,2772,"F",8) S DIP(1)=$S($D(^PRC(424,D0,0)):^(0),1:"") S X=$P(DIP(1),U,8),X=X W X K DIP;X;"";Z;"INTERNAL(#.08)"~"USER: ";C40;""~.08;X;""~ "KRN",.4,2772,"F",9) -200,^VA(200,^^S I(0,0)=D0 S DIP(1)=$S($D(^PRC(424,D0,0)):^(0),1:"") S X=$P(DIP(1),U,8),X=X S D(0)=+X;Z;".08:"~-200,"USER SVC IEN: ";C1;""~ "KRN",.4,2772,"F",10) -200,S DIP(101)=$S($D(^VA(200,D0,5)):^(5),1:"") S X=$P(DIP(101),U,1),X=X W X K DIP;X;"";Z;"INTERNAL(#29)"~-200,"USER SVC: ";C40;""~-200,29;X;""~ "KRN",.4,2772,"F",11) "COMPLETED FLAG: ";C1;""~.09;X;""~"REFERENCE: ";C1;""~.1;X;""~"LAST SEQ USED: ";C1;""~.11;X;""~"AUTHORIZATION AMT: ";C40;""~.12;X;""~ "KRN",.4,2772,"F",12) "ORIG AUTHORIZTION AMT: ";C1;""~.13;X;""~"LAST EDITOR DUZ: ";C1;""~ "KRN",.4,2772,"F",13) S DIP(1)=$S($D(^PRC(424,D0,0)):^(0),1:"") S X=$P(DIP(1),U,14),X=X W X K DIP;X;"";Z;"INTERNAL(#.14)"~"LAST EDITED BY: ";C40;""~.14;X;""~ "KRN",.4,2772,"F",14) -200,^VA(200,^^S I(0,0)=D0 S DIP(1)=$S($D(^PRC(424,D0,0)):^(0),1:"") S X=$P(DIP(1),U,14),X=X S D(0)=+X;Z;".14:"~-200,"LAST EDITOR SVC IEN: ";C1;""~ "KRN",.4,2772,"F",15) -200,S DIP(101)=$S($D(^VA(200,D0,5)):^(5),1:"") S X=$P(DIP(101),U,1),X=X W X K DIP;X;"";Z;"INTERNAL(#29)"~-200,"EDITOR'S SVC: ";C40;""~-200,29;X;""~ "KRN",.4,2772,"F",16) "CPA IEN: ";C1;""~S DIP(1)=$S($D(^PRC(424,D0,0)):^(0),1:"") S X=$P(DIP(1),U,15),X=X W X K DIP;X;"";Z;"INTERNAL(#.15)"~"CPA POINTER: ";C40;""~.15;X;""~ "KRN",.4,2772,"F",17) "COMMENTS: ";C1;""~1.1;X;""~"INTERFACE ID: ";C1;""~4;X;""~" ";C1;""~ "KRN",.4,2772,"H") 1358 DAILY RECORD DATA "KRN",.4,2773,-1) 0^4 "KRN",.4,2773,0) PRCHLO410_HDR_VALIDATE^3090507.1131^@^410^^@^3090514 "KRN",.4,2773,"F",1) "TRANSACTION#: ";C1;""~.01;X;""~"TRANSACTION IEN: ";C40;""~0;X;""~"STATION#: ";C1;""~.5;X;""~"TRANSACTION TYPE: ";C40;""~1;X;""~"FORM TYPE: ";C1;""~ "KRN",.4,2773,"F",2) 3;X;""~"SUBSTATION IEN: ";C1;""~S DIP(1)=$S($D(^PRCS(410,D0,0)):^(0),1:"") S X=$P(DIP(1),U,10),X=X W X K DIP;X;"";Z;"INTERNAL(#448)"~ "KRN",.4,2773,"F",3) "SUBSTATION: ";C40;""~448;X;""~"RUNNING BAL QUARTER DATE: ";C1;""~ "KRN",.4,2773,"F",4) S DIP(1)=$S($D(^PRCS(410,D0,0)):^(0),1:"") S X=$P(DIP(1),U,11),X=$P(X,".",1) S Y=X D DT K DIP;X;"";d;L18;Z;"DATE(RUNNING BALANCE QUARTER DATE)"~ "KRN",.4,2773,"F",5) "RUNNING BAL STATUS: ";C40;""~450;X;""~"DATE OF REQUEST: ";C1;""~ "KRN",.4,2773,"F",6) S DIP(1)=$S($D(^PRCS(410,D0,1)):^(1),1:"") S X=$P(DIP(1),U,1),X=$P(X,".",1) S Y=X D DT K DIP;X;"";d;L18;Z;"DATE(DATE OF REQUEST)"~ "KRN",.4,2773,"F",7) "CLASSIFICATION IEN: ";C1;""~S DIP(1)=$S($D(^PRCS(410,D0,1)):^(1),1:"") S X=$P(DIP(1),U,5),X=X W X K DIP;X;"";Z;"INTERNAL(#8)"~ "KRN",.4,2773,"F",8) "CLASSIFICATION: ";C40;""~8;X;""~"VENDOR (FREETXT): ";C1;""~11;X;""~"VENDOR ADDR1: ";C40;""~11.1;X;""~"VENDOR ADDR2: ";C1;""~11.2;X;""~ "KRN",.4,2773,"F",9) "VENDOR ADDR3: ";C40;""~11.3;X;""~"VENDOR ADDR4: ";C1;""~11.4;X;""~"VENDOR CITY: ";C40;""~11.5;X;""~ "KRN",.4,2773,"F",10) -5,^DIC(5,^^S I(0,0)=D0 S DIP(1)=$S($D(^PRCS(410,D0,2)):^(2),1:"") S X=$P(DIP(1),U,7),X=X S D(0)=+X;Z;"11.6:"~-5,"VENDOR STATE: ";C1;""~-5,1;X;""~ "KRN",.4,2773,"F",11) "VENDOR ZIPCODE: ";C40;""~S DIP(1)=$S($D(^PRCS(410,D0,2)):^(2),1:"") S X=$P(DIP(1),U,8),X=X W X K DIP;X;"";Z;"INTERNAL(VENDOR ZIP CODE)"~ "KRN",.4,2773,"F",12) "VENDOR CONTACT: ";C1;""~11.8;X;""~"VENDOR PHONE: ";C40;""~11.9;X;""~"VENDOR IEN: ";C1;""~ "KRN",.4,2773,"F",13) S DIP(1)=$S($D(^PRCS(410,D0,3)):^(3),1:"") S X=$P(DIP(1),U,4),X=X W X K DIP;X;"";Z;"INTERNAL(#12)"~"VENDOR(PTR): ";C40;""~12;X;""~ "KRN",.4,2773,"F",14) -440,^PRC(440,^^S I(0,0)=D0 S DIP(1)=$S($D(^PRCS(410,D0,3)):^(3),1:"") S X=$P(DIP(1),U,4),X=X S D(0)=+X;Z;"12:"~-440,"FMS VENDOR CODE: ";C1;""~-440,34;X;""~ "KRN",.4,2773,"F",15) -440,"ALT-ADDR-IND: ";C40;""~-440,35;X;""~-440,"DUN & BRADSTREET#: ";C1;""~-440,18.3;X;""~"CONTRACT#: ";C40;""~13;X;""~"FCP: ";C1;""~15;X;""~ "KRN",.4,2773,"F",16) "COST CENTER: ";C40;""~15.5;X;""~"BOC1: ";C1;""~17;X;""~"BOC1 $ AMT: ";C40;""~17.5;X;""~"ACCOUNTING DATA: ";C1;""~28;X;""~"FCP/PRJ: ";C40;""~28.1;X;""~ "KRN",.4,2773,"F",17) "BBFY: ";C1;""~28.5;X;""~"COMMITTED COST: ";C40;""~S DIP(1)=$S($D(^PRCS(410,D0,4)):^(4),1:"") S X=$P(DIP(1),U,1),X=X W X K DIP;X;"";Z;"INTERNAL(#20)"~ "KRN",.4,2773,"F",18) "DATE COMMITTED: ";C1;""~ "KRN",.4,2773,"F",19) S DIP(1)=$S($D(^PRCS(410,D0,4)):^(4),1:"") S X=$P(DIP(1),U,2),X=$P(X,".",1) S Y=X D DT K DIP;X;"";d;L18;Z;"DATE(DATE COMMITTED)"~ "KRN",.4,2773,"F",20) "OBLIGATED COST: ";C40;""~22;X;""~"DATE OBLIGATED: ";C1;""~ "KRN",.4,2773,"F",21) S DIP(1)=$S($D(^PRCS(410,D0,4)):^(4),1:"") S X=$P(DIP(1),U,4),X=$P(X,".",1) S Y=X D DT K DIP;X;"";d;L18;Z;"DATE(DATE OBLIGATED)"~"PO#: ";C40;""~ "KRN",.4,2773,"F",22) 24;X;""~"ADJUSTMENT $ AMT: ";C1;""~25;X;""~"DATE OBL ADJUSTED: ";C40;""~ "KRN",.4,2773,"F",23) S DIP(1)=$S($D(^PRCS(410,D0,4)):^(4),1:"") S X=$P(DIP(1),U,7),X=$P(X,".",1) S Y=X D DT K DIP;X;"";d;L18;Z;"DATE(DATE OBL ADJUSTED)"~ "KRN",.4,2773,"F",24) "TRANSACTION AMT: ";C1;""~S DIP(1)=$S($D(^PRCS(410,D0,4)):^(4),1:"") S X=$P(DIP(1),U,8),X=X W X K DIP;X;"";Z;"INTERNAL(#27)"~"OBIGATOR'S DUZ: ";C1;""~ "KRN",.4,2773,"F",25) S DIP(1)=$S($D(^PRCS(410,D0,4)):^(4),1:"") S X=$P(DIP(1),U,9),X=X W X K DIP;X;"";Z;"INTERNAL(#29)"~"OBLIGATED BY: ";C40;""~29;X;""~ "KRN",.4,2773,"F",26) -200,^VA(200,^^S I(0,0)=D0 S DIP(1)=$S($D(^PRCS(410,D0,4)):^(4),1:"") S X=$P(DIP(1),U,9),X=X S D(0)=+X;Z;"29:"~-200,"OBLIGATOR SVC IEN: ";C1;""~ "KRN",.4,2773,"F",27) -200,S DIP(101)=$S($D(^VA(200,D0,5)):^(5),1:"") S X=$P(DIP(101),U,1),X=X W X K DIP;X;"";Z;"INTERNAL(#29)"~-200,"OBLIGATOR SVC: ";C40;""~-200,29;X;""~ "KRN",.4,2773,"F",28) "OBLIGATION VAL DATE/TIME: ";C1;""~ "KRN",.4,2773,"F",29) S DIP(1)=$S($D(^PRCS(410,D0,4)):^(4),1:"") S X=$P(DIP(1),U,13),X=$P(X,".",1) S Y=X D DT K DIP;X;"";d;L18;Z;"DATE(OBLIGATION VAL CODE DATE/TIME)"~ "KRN",.4,2773,"F",30) "REQUESTOR'S DUZ: ";C1;""~S DIP(1)=$S($D(^PRCS(410,D0,7)):^(7),1:"") S X=$P(DIP(1),U,1),X=X W X K DIP;X;"";Z;"INTERNAL(#40)"~"REQUESTOR: ";C40;""~ "KRN",.4,2773,"F",31) 40;X;""~-200,^VA(200,^^S I(0,0)=D0 S DIP(1)=$S($D(^PRCS(410,D0,7)):^(7),1:"") S X=$P(DIP(1),U,1),X=X S D(0)=+X;Z;"40:"~-200,"REQUESTOR'S SVC IEN: ";C1;""~ "KRN",.4,2773,"F",32) -200,S DIP(101)=$S($D(^VA(200,D0,5)):^(5),1:"") S X=$P(DIP(101),U,1),X=X W X K DIP;X;"";Z;"INTERNAL(#29)"~-200,"REQUESTOR'S SVC: ";C40;""~-200,29;X;""~ "KRN",.4,2773,"F",33) "REQUESTOR'S TITLE: ";C1;""~41;X;""~"APPROVING OFFICIAL'S DUZ: ";C1;""~ "KRN",.4,2773,"F",34) S DIP(1)=$S($D(^PRCS(410,D0,7)):^(7),1:"") S X=$P(DIP(1),U,3),X=X W X K DIP;X;"";Z;"INTERNAL(#42)"~"APPROVING OFFICIAL: ";C40;""~42;X;""~ "KRN",.4,2773,"F",35) -200,^VA(200,^^S I(0,0)=D0 S DIP(1)=$S($D(^PRCS(410,D0,7)):^(7),1:"") S X=$P(DIP(1),U,3),X=X S D(0)=+X;Z;"42:"~-200,"APPROVING OFFICIAL'S SVC IEN: ";C1;""~ "KRN",.4,2773,"F",36) -200,S DIP(101)=$S($D(^VA(200,D0,5)):^(5),1:"") S X=$P(DIP(101),U,1),X=X W X K DIP;X;"";Z;"INTERNAL(#29)"~-200,"APPR OFFICIAL SVC: ";C40;""~-200,29;X;""~ "KRN",.4,2773,"F",37) "APPR OFFICIAL TITLE: ";C1;""~43;X;""~"DATE SIGNED: ";C40;""~ "KRN",.4,2773,"F",38) S DIP(1)=$S($D(^PRCS(410,D0,7)):^(7),1:"") S X=$P(DIP(1),U,5),X=$P(X,".",1) S Y=X D DT K DIP;X;"";d;L18;Z;"DATE(DATE SIGNED (APPROVED))"~ "KRN",.4,2773,"F",39) "ES CODE DATE/TIME: ";C1;""~ "KRN",.4,2773,"F",40) S DIP(1)=$S($D(^PRCS(410,D0,7)):^(7),1:"") S X=$P(DIP(1),U,7),X=$P(X,".",1) S Y=X D DT K DIP;X;"";d;L18;Z;"DATE(ES CODE DATE/TIME)"~ "KRN",.4,2773,"F",41) "JUSTIFICATION: ";C1;""~45,.01;X;""~"SORT GROUP: ";C1;""~49;X;""~"POIDNUM: ";C1;""~ "KRN",.4,2773,"F",42) S DIP(1)=$S($D(^PRCS(410,D0,10)):^(10),1:"") S X=$P(DIP(1),U,3),X=X W X K DIP;X;"";Z;"INTERNAL(#52)"~"STATION# - PO#: ";C40;""~52;X;""~ "KRN",.4,2773,"F",43) -442,^PRC(442,^^S I(0,0)=D0 S DIP(1)=$S($D(^PRCS(410,D0,10)):^(10),1:"") S X=$P(DIP(1),U,3),X=X S D(0)=+X;Z;"52:"~-442,"P.O. DATE: ";C1;""~ "KRN",.4,2773,"F",44) -442,S DIP(101)=$S($D(^PRC(442,D0,1)):^(1),1:"") S X=$P(DIP(101),U,15),X=$P(X,".",1) S Y=X D DT K DIP;X;"";d;L18;Z;"DATE(#.1)"~"STATUS: ";C40;""~ "KRN",.4,2773,"F",45) 54;X;L30;""~"COMMENTS: ";C1;""~60,.01;X;""~"REASON FOR RETURN: ";C1;""~61,.01;X;""~ "KRN",.4,2773,"H") CONTROL POINT ACTIVITIES DATA "KRN",.4,2774,-1) 0^5 "KRN",.4,2774,0) PRCHLO424-1_VALIDATE^3090426.2338^@^424.1^^@^3090511 "KRN",.4,2774,"F",1) -424,^PRC(424,^^S I(0,0)=D0 S DIP(1)=$S($D(^PRC(424.1,D0,0)):^(0),1:"") S X=$P(DIP(1),U,2),X=X S D(0)=+X;Z;"AUTHORIZATION POINTER:"~-424,"POIDNUM: ";C1~ "KRN",.4,2774,"F",2) -424,S DIP(101)=$S($D(^PRC(424,D0,0)):^(0),1:"") S X=$P(DIP(101),U,2),X=X W X K DIP;X;"";Z;"INTERNAL(#.02)"~-424,"PO#: ";C40;""~-424,.02;X;""~ "KRN",.4,2774,"F",3) -424,-442,^PRC(442,^^S I(100,0)=D0 S DIP(101)=$S($D(^PRC(424,D0,0)):^(0),1:"") S X=$P(DIP(101),U,2),X=X S D(0)=+X;Z;".02:"~-424,-442,"P.O. DATE: ";C1;""~ "KRN",.4,2774,"F",4) -424,-442,S DIP(201)=$S($D(^PRC(442,D0,1)):^(1),1:"") S X=$P(DIP(201),U,15),X=$P(X,".",1) S Y=X D DT K DIP;X;"";Z;"DATE(#.1)";d;L18~ "KRN",.4,2774,"F",5) -424,-442,"STATION#: ";C40;""~ "KRN",.4,2774,"F",6) -424,-442,S DIP(201)=$S($D(^PRC(442,D0,0)):^(0),1:"") S X=$P(DIP(201),U,1),DIP(202)=$G(X) S X="-",X=$P(DIP(202),X) W X K DIP;X;"";Z;"$P(#.01,"-")"~ "KRN",.4,2774,"F",7) "BILL NUMBER: ";C1;""~.01;X;""~"RECORD TYPE: ";C40;""~.011;X;""~"AUTHORIZATION IEN: ";C1;""~ "KRN",.4,2774,"F",8) S DIP(1)=$S($D(^PRC(424.1,D0,0)):^(0),1:"") S X=$P(DIP(1),U,2),X=X W X K DIP;X;"";Z;"INTERNAL(#.02)"~"AUTHORIZATION POINTER: ";C40;""~.02;X;""~ "KRN",.4,2774,"F",9) "AUTHORIZATION AMT: ";C1;""~.03;X;""~"DATE/TIME: ";C40;""~ "KRN",.4,2774,"F",10) S DIP(1)=$S($D(^PRC(424.1,D0,0)):^(0),1:"") S X=$P(DIP(1),U,4),X=$P(X,".",1) S Y=X D DT K DIP;X;"";Z;"DATE(DATE/TIME)";d;L18~"USER DUZ: ";C1;""~ "KRN",.4,2774,"F",11) S DIP(1)=$S($D(^PRC(424.1,D0,0)):^(0),1:"") S X=$P(DIP(1),U,5),X=X W X K DIP;X;"";Z;"INTERNAL(#.05)"~"USER: ";C40;""~.05;X;""~ "KRN",.4,2774,"F",12) -200,^VA(200,^^S I(0,0)=D0 S DIP(1)=$S($D(^PRC(424.1,D0,0)):^(0),1:"") S X=$P(DIP(1),U,5),X=X S D(0)=+X;Z;".05:"~-200,"USER SVC IEN: ";C1;""~ "KRN",.4,2774,"F",13) -200,S DIP(101)=$S($D(^VA(200,D0,5)):^(5),1:"") S X=$P(DIP(101),U,1),X=X W X K DIP;X;"";Z;"INTERNAL(#29)"~-200,"USER SERVICE: ";C40;""~-200,29;X;""~ "KRN",.4,2774,"F",14) "VENDOR INVOICE: ";C1;""~.06;X;""~"FINAL BILL: ";C40;""~.07;X;""~"REFERENCE: ";C1;""~.08;X;""~"LAST EDITOR DUZ: ";C1;""~ "KRN",.4,2774,"F",15) S DIP(1)=$S($D(^PRC(424.1,D0,0)):^(0),1:"") S X=$P(DIP(1),U,10),X=X W X K DIP;X;"";Z;"INTERNAL(#.1)"~"LAST EDITED BY: ";C40;""~.1;X;""~ "KRN",.4,2774,"F",16) -200,^VA(200,^^S I(0,0)=D0 S DIP(1)=$S($D(^PRC(424.1,D0,0)):^(0),1:"") S X=$P(DIP(1),U,10),X=X S D(0)=+X;Z;".1:"~-200,"EDITOR SVC IEN: ";C1;""~ "KRN",.4,2774,"F",17) -200,S DIP(101)=$S($D(^VA(200,D0,5)):^(5),1:"") S X=$P(DIP(101),U,1),X=X W X K DIP;X;"";Z;"INTERNAL(#29)"~-200,"EDITOR'S SVC: ";C40;""~-200,29;X;""~ "KRN",.4,2774,"F",18) "DESCRIPTION: ";C1;""~1.1;X;""~" ";C1;""~ "KRN",.4,2774,"H") 1358 AUTHORIZATION DETAIL DATA "KRN",.4,2775,-1) 0^3 "KRN",.4,2775,0) PRCHLO410-04_VALIDATE^3090426.2258^@^410^^@^3090529 "KRN",.4,2775,"F",1) "TRANSACTION#: ";C1;""~.01;X;""~"TRANSACTION IEN: ";C40;""~0;X;""~"STATION#: ";C1;""~.5;X;""~"STATION-PO IEN: ";C1;""~ "KRN",.4,2775,"F",2) S DIP(1)=$S($D(^PRCS(410,D0,10)):^(10),1:"") S X=$P(DIP(1),U,3),X=X W X K DIP;X;"";Z;"INTERNAL(#52)"~"STATION NO - PO NO: ";C40;""~52;X;""~ "KRN",.4,2775,"F",3) -442,^PRC(442,^^S I(0,0)=D0 S DIP(1)=$S($D(^PRCS(410,D0,10)):^(10),1:"") S X=$P(DIP(1),U,3),X=X S D(0)=+X;Z;"52:"~-442,"P.O. DATE: ";C1;""~ "KRN",.4,2775,"F",4) -442,S DIP(101)=$S($D(^PRC(442,D0,1)):^(1),1:"") S X=$P(DIP(101),U,15),X=$P(X,".",1) S Y=X D DT K DIP;X;"";Z;"DATE(#.1)";d;L18~ "KRN",.4,2775,"F",5) 16,"SUB-CONTROL PT: ";C1;""~16,.01;X;""~16,"AMOUNT: ";C40;""~16,1;X;""~16,"SCP AMT: ";C1;""~16,2;X;""~" ";C1;""~ "KRN",.4,2775,"H") SUB CONTROL POINT DATA "KRN",.4,2776,-1) 0^15 "KRN",.4,2776,0) PRCHLO442_HDR_VALIDATE^3090428.1709^@^442^^@^3090511 "KRN",.4,2776,"F",1) "POIDNUM: ";C1;""~0;X;""~"PO#: ";C40;""~.01;X;""~"P.O. DATE: ";C1;""~ "KRN",.4,2776,"F",2) S DIP(1)=$S($D(^PRC(442,D0,1)):^(1),1:"") S X=$P(DIP(1),U,15),X=$P(X,".",1) S Y=X D DT K DIP;X;"";d;L18;Z;"DATE(#.1)"~"STATION#: ";C40;""~ "KRN",.4,2776,"F",3) S DIP(1)=$S($D(^PRC(442,D0,0)):^(0),1:"") S X=$P(DIP(1),U,1),DIP(2)=$G(X) S X="-",X=$P(DIP(2),X) W X K DIP;X;"";Z;"$P(#.01,"-")"~ "KRN",.4,2776,"F",4) "PRIMARY 2237: ";C1;""~.07;X;""~"MOP: ";C40;""~.02;X;""~"LOCAL PROCURMENT REASON: ";C1;""~ "KRN",.4,2776,"F",5) -443.8,^PRC(443.8,^^S I(0,0)=D0 S DIP(1)=$S($D(^PRC(442,D0,1)):^(1),1:"") S X=$P(DIP(1),U,19),X=X S D(0)=+X;Z;".25:"~-443.8,1;X;""~ "KRN",.4,2776,"F",6) "EXPENDABLE/NONEXPENDABLE: ";C40;""~S DIP(1)=$S($D(^PRC(442,D0,1)):^(1),1:"") S X=$P(DIP(1),U,18),X=X W X K DIP;X;"";Z;"INTERNAL(#.3)"~ "KRN",.4,2776,"F",7) "SUPPLY STATUS: ";C1;""~.5;X;""~"SUPPLY STATUS ORDER: ";C40;""~.7;X;""~"FISCAL STATUS ORDER: ";C1;""~.8;X;""~"FCP: ";C40;""~1;X;""~ "KRN",.4,2776,"F",8) "APPROPRIATION: ";C1;""~1.4;X;""~"COST CENTER: ";C40;""~2;X;""~"SUBACCOUNT1: ";C1;""~3;X;""~"SUBAMOUNT1: ";C40;""~3.4;X;""~"SUBACCOUNT2: ";C1;""~ "KRN",.4,2776,"F",9) 4;X;""~"SUBAMOUNT2: ";C40;""~4.4;X;""~"PRIMARY 2237 IEN: ";C1;""~ "KRN",.4,2776,"F",10) S DIP(1)=$S($D(^PRC(442,D0,0)):^(0),1:"") S X=$P(DIP(1),U,12),X=X W X K DIP;X;"";Z;"INTERNAL(#.07)"~"MOP IEN: ";C40;""~ "KRN",.4,2776,"F",11) S DIP(1)=$S($D(^PRC(442,D0,0)):^(0),1:"") S X=$P(DIP(1),U,2),X=X W X K DIP;X;"";Z;"INTERNAL(#.02)"~"SUPPLY STATUS IEN: ";C1;""~ "KRN",.4,2776,"F",12) S DIP(1)=$S($D(^PRC(442,D0,7)):^(7),1:"") S X=$P(DIP(1),U,1),X=X W X K DIP;X;"";Z;"INTERNAL(#.5)"~"SUBACCOUNT1 IEN: ";C40;""~ "KRN",.4,2776,"F",13) S DIP(1)=$S($D(^PRC(442,D0,0)):^(0),1:"") S X=$P(DIP(1),U,6),X=X W X K DIP;X;"";Z;"INTERNAL(#3)"~"SUBACCOUNT2 IEN: ";C1;""~ "KRN",.4,2776,"F",14) S DIP(1)=$S($D(^PRC(442,D0,0)):^(0),1:"") S X=$P(DIP(1),U,8),X=X W X K DIP;X;"";Z;"INTERNAL(#4)"~"VENDOR: ";C1;""~5;X;""~"REQUESTING SVC: ";C40;""~ "KRN",.4,2776,"F",15) 5.2;X;""~"F.O.B. POINT: ";C1;""~S DIP(1)=$S($D(^PRC(442,D0,1)):^(1),1:"") S X=$P(DIP(1),U,6),X=X W X K DIP;X;"";Z;"INTERNAL(#6.4)"~ "KRN",.4,2776,"F",16) "ORIGINAL DELIVERY DATE: ";C40;""~ "KRN",.4,2776,"F",17) S DIP(1)=$S($D(^PRC(442,D0,0)):^(0),1:"") S X=$P(DIP(1),U,20),X=$P(X,".",1) S Y=X D DT K DIP;X;"";d;L18;Z;"DATE(ORIGINAL DELIVERY DATE)"~ "KRN",.4,2776,"F",18) "ESTIMATED COST: ";C1;""~7.2;X;""~"SOURCE CODE: ";C40;""~ "KRN",.4,2776,"F",19) -420.8,^PRCD(420.8,^^S I(0,0)=D0 S DIP(1)=$S($D(^PRC(442,D0,1)):^(1),1:"") S X=$P(DIP(1),U,7),X=X S D(0)=+X;Z;"8:"~-420.8,1;X;""~ "KRN",.4,2776,"F",20) "EST SHIPPING/HANDLING: ";C1;""~13;X;""~"EST SHIPPING LINE NO: ";C40~13.1;X;""~"LINE ITEM COUNT: ";C1;""~15;X;""~"PA/PPM/BUYER: ";C40;""~16;X;""~ "KRN",.4,2776,"F",21) "AGENT ASSIGNED: ";C1;""~19;X;""~"DATE P.O. ASSIGNED: ";C40;""~ "KRN",.4,2776,"F",22) S DIP(1)=$S($D(^PRC(442,D0,12)):^(12),1:"") S X=$P(DIP(1),U,5),X=$P(X,".",1) S Y=X D DT K DIP;X;"";d;L18;Z;"DATE(DATE P.O. ASSIGNED)"~ "KRN",.4,2776,"F",23) "REMARKS: ";C1;""~25,.01;X;""~"OLD PO RECORD: ";C1;""~27;X;""~"NEW PO RECORD: ";C1;""~28;X;""~ "KRN",.4,2776,"F",24) -200,^VA(200,^^S I(0,0)=D0 S DIP(1)=$S($D(^PRC(442,D0,1)):^(1),1:"") S X=$P(DIP(1),U,10),X=X S D(0)=+X;Z;"16:"~-200,"PA/PPM/BUYER SVC IEN: ";C1;""~ "KRN",.4,2776,"F",25) -200,S DIP(101)=$S($D(^VA(200,D0,5)):^(5),1:"") S X=$P(DIP(101),U,1),X=X W X K DIP;X;"";Z;"INTERNAL(#29)"~-200,"PA/PPM/BUYER SVC: ";C40;""~-200,29;X;""~ "KRN",.4,2776,"F",26) "AGENT ASSIGNED DUZ: ";C1;""~S DIP(1)=$S($D(^PRC(442,D0,12)):^(12),1:"") S X=$P(DIP(1),U,4),X=X W X K DIP;X;"";Z;"INTERNAL(#19)"~ "KRN",.4,2776,"F",27) -200,^VA(200,^^S I(0,0)=D0 S DIP(1)=$S($D(^PRC(442,D0,12)):^(12),1:"") S X=$P(DIP(1),U,4),X=X S D(0)=+X;Z;"19:"~-200,"AGENT ASSIGNED SVC IEN: ";C1;""~ "KRN",.4,2776,"F",28) -200,S DIP(101)=$S($D(^VA(200,D0,5)):^(5),1:"") S X=$P(DIP(101),U,1),X=X W X K DIP;X;"";Z;"INTERNAL(#29)"~-200,"AGENT ASSIGNED SVC: ";C40;""~-200,29;X;""~ "KRN",.4,2776,"F",29) "PCDO VENDOR: ";C1;""~53;X;""~"PC USER: ";C40;""~56;X;""~"PURCHASE COST: ";C1;""~60;X;""~"PC HOLDER: ";C40;""~61;X;""~"PCDO 2237: ";C1;""~62;X;""~ "KRN",.4,2776,"F",30) "TOTAL AMT: ";C40;""~91;X;""~"NET AMT: ";C1;""~92;X;""~ "KRN",.4,2776,"F",31) -200,^VA(200,^^S I(0,0)=D0 S DIP(1)=$S($D(^PRC(442,D0,23)):^(23),1:"") S X=$P(DIP(1),U,17),X=X S D(0)=+X;Z;"56:"~-200,"PC USER SVC IEN: ";C1;""~ "KRN",.4,2776,"F",32) -200,S DIP(101)=$S($D(^VA(200,D0,5)):^(5),1:"") S X=$P(DIP(101),U,1),X=X W X K DIP;X;"";Z;"INTERNAL(#29)"~-200,"PC USER SVC: ";C40;""~-200,29;X;""~ "KRN",.4,2776,"F",33) "";C1;""~-200,^VA(200,^^S I(0,0)=D0 S DIP(1)=$S($D(^PRC(442,D0,23)):^(23),1:"") S X=$P(DIP(1),U,22),X=X S D(0)=+X;Z;"61:"~-200,"PC HOLDER SVC IEN: ";C1;""~ "KRN",.4,2776,"F",34) -200,S DIP(101)=$S($D(^VA(200,D0,5)):^(5),1:"") S X=$P(DIP(101),U,1),X=X W X K DIP;X;"";Z;"INTERNAL(#29)"~-200,"PC HOLDER SVC: ";C40;""~-200,29;X;""~ "KRN",.4,2776,"F",35) "BBFY: ";C1;""~26;X;""~"SERVICE END DATE: ";C40;""~ "KRN",.4,2776,"F",36) S DIP(1)=$S($D(^PRC(442,D0,23)):^(23),1:"") S X=$P(DIP(1),U,5),X=$P(X,".",1) S Y=X D DT K DIP;X;"";d;L18;Z;"DATE(END DATE FOR SERVICE ORDER)"~ "KRN",.4,2776,"F",37) "AUTO ACCRUE: ";C1;""~30;X;""~"SUBSTATION IEN: ";C1;""~ "KRN",.4,2776,"F",38) S DIP(1)=$S($D(^PRC(442,D0,23)):^(23),1:"") S X=$P(DIP(1),U,7),X=X W X K DIP;X;"";Z;"INTERNAL(SUBSTATION)"~"SUBSTATION: ";C40;""~31;X;""~ "KRN",.4,2776,"F",39) "VENDOR IEN: ";C1;""~S DIP(1)=$S($D(^PRC(442,D0,1)):^(1),1:"") S X=$P(DIP(1),U,1),X=X W X K DIP;X;"";Z;"INTERNAL(VENDOR)"~ "KRN",.4,2776,"F",40) -440,^PRC(440,^^S I(0,0)=D0 S DIP(1)=$S($D(^PRC(442,D0,1)):^(1),1:"") S X=$P(DIP(1),U,1),X=X S D(0)=+X;Z;"VENDOR:"~-440,"FMS VENDOR CODE: ";C1;""~ "KRN",.4,2776,"F",41) -440,34;X;""~-440,"ALT-ADDR-IND: ";C40;""~-440,35;X;""~-440,"DUN & BRADSTREET#: ";C1;""~-440,18.3;X;""~"MONTH: ";C1;""~21;X;""~"QUARTER: ";C40;""~ "KRN",.4,2776,"F",42) 22;X;""~"LAST DIGIT FY: ";C1;""~23;X;""~"ACTUAL 1358 BAL: ";C1;""~94;X;""~"FISCAL 1358 BAL: ";C40;""~95;X;""~"ESTIMATED 1358 BAL: ";C1;""~96;X;""~ "KRN",.4,2776,"F",43) "BULLETIN SENT: ";C40;""~96.7;X;""~"INTERFACE PACKAGE PREFIX: ";C1;""~65;X;""~"DOCUMENT ID/COMMON NO.: ";C40;""~102;X;""~ "KRN",.4,2776,"F",44) "DO YOU WANT TO SEND EDI?: ";C1;""~116;X;""~"REASON NOT COMPETED: ";C1;""~117;X;""~"NUMBER OF OFFERS: ";C40;""~118;X;""~"PRE AWARD SYNOPSIS: ";C1;""~ "KRN",.4,2776,"F",45) 119;X;""~"ALTERNATIVE ADVERTIZING: ";C40;""~120;X;""~"SOLICITATION PROCEDURE: ";C1;""~121;X;""~"EVALUATED PREFERENCE: ";C40;""~122;X;""~ "KRN",.4,2776,"F",46) "FUNDING AGENCY CODE: ";C1;""~123;X;""~"FUNDING AGENCY OFFICE CODE: ";C40;""~124;X;""~"MULTIYEAR: ";C1;""~125;X;""~"EPA DESIGNATED PRODUCT: ";C40;""~ "KRN",.4,2776,"F",47) 126;X;""~"CONTRACT BUNDLING: ";C1;""~127;X;""~"EXTENT COMPETED: ";C40;""~128;X;""~"PERFORMANCE BASED SVC CONTRACT: ";C1;""~129;X;""~ "KRN",.4,2776,"F",48) "CLINGER COHEN: ";C40;""~130;X;""~"PLACE OF PERFORMANCE THIS STATION: ";C1;""~131;X;""~"PLACE OF PERFORMANCE: ";C40;""~132;X;""~"SEND TO FPDS: ";C1;""~ "KRN",.4,2776,"F",49) 133;X;""~"PA BUYER DUZ: ";C1;""~S DIP(1)=$S($D(^PRC(442,D0,1)):^(1),1:"") S X=$P(DIP(1),U,10),X=X W X K DIP;X;"";Z;"INTERNAL(#16)"~ "KRN",.4,2776,"F",50) "PC USER DUZ: ";C40;""~S DIP(1)=$S($D(^PRC(442,D0,23)):^(23),1:"") S X=$P(DIP(1),U,17),X=X W X K DIP;X;"";Z;"INTERNAL(#56)"~"PC HOLDER DUZ: ";C1;""~ "KRN",.4,2776,"F",51) S DIP(1)=$S($D(^PRC(442,D0,23)):^(23),1:"") S X=$P(DIP(1),U,22),X=X W X K DIP;X;"";Z;"INTERNAL(#61)"~" ";C1;""~ "KRN",.4,2776,"H") PO MASTER DATA "KRN",.4,2777,-1) 0^20 "KRN",.4,2777,0) PRCHLO442_OBLIG_VALIDATE^3090427.1048^@^442^^@^3090511 "KRN",.4,2777,"DXS",1,9.2) S DIP(1)=$S($D(^PRC(442,D0,10,D1,0)):^(0),1:"") S X=$P(DIP(1),U,1),DIP(2)=$G(X) S X=".",DIP(3)=$G(X) S X=5,X=$P(DIP(2),DIP(3),X),DIP(4)=$G(X) S X="@" "KRN",.4,2777,"F",1) "POIDNUM: ";C1;""~0;X;""~"PO#: ";C40;""~.01;X;""~"P.O. DATE: ";C1;""~ "KRN",.4,2777,"F",2) S DIP(1)=$S($D(^PRC(442,D0,1)):^(1),1:"") S X=$P(DIP(1),U,15),X=$P(X,".",1) S Y=X D DT K DIP;X;"";d;L18;Z;"DATE(#.1)"~"STATION#: ";C40;""~ "KRN",.4,2777,"F",3) S DIP(1)=$S($D(^PRC(442,D0,0)):^(0),1:"") S X=$P(DIP(1),U,1),DIP(2)=$G(X) S X="-",X=$P(DIP(2),X) W X K DIP;X;"";Z;"$P(#.01,"-")"~ "KRN",.4,2777,"F",4) 2.4,"OBLIGATION IEN: ";C1;""~2.4,0;X;""~2.4,"TDATEREF: ";C40;""~2.4,X DXS(1,9.2) S X=$P(DIP(4),X) W X K DIP;X;"";Z;"$P($P(#.01,".",5),"@")"~ "KRN",.4,2777,"F",5) 2.4,"OBLIGATED BY: ";C1;""~2.4,1;X;""~2.4,"TRANSACTION AMT: ";C40;""~2.4,2;X;""~2.4,"AMENDMENT#: ";C1;""~2.4,7;X;""~2.4,"1358 ADJUSTMENT: ";C40;""~ "KRN",.4,2777,"F",6) 2.4,8;X;""~2.4,"OBLIGATOR'S DUZ: ";C1;""~2.4,S DIP(1)=$S($D(^PRC(442,D0,10,D1,0)):^(0),1:"") S X=$P(DIP(1),U,2),X=X W X K DIP;X;"";Z;"INTERNAL(#1)"~ "KRN",.4,2777,"F",7) 2.4,"1358 ADJ IEN: ";C40;""~2.4,S DIP(1)=$S($D(^PRC(442,D0,10,D1,0)):^(0),1:"") S X=$P(DIP(1),U,11),X=X W X K DIP;X;"";Z;"INTERNAL(#8)"~ "KRN",.4,2777,"F",8) 2.4,"DATE SIGNED: ";C1;""~2.4,S DIP(1)=$S($D(^PRC(442,D0,10,D1,0)):^(0),1:"") S X=$P(DIP(1),U,6),X=$P(X,".",1) S Y=X D DT K DIP;X;"";d;L18;Z;"DATE(#5)"~ "KRN",.4,2777,"F",9) 2.4,"OBLIGATION PROC DATE: ";C40;""~ "KRN",.4,2777,"F",10) 2.4,S DIP(1)=$S($D(^PRC(442,D0,10,D1,0)):^(0),1:"") S X=$P(DIP(1),U,12),X=$P(X,".",1) S Y=X D DT K DIP;X;"";d;L18;Z;"DATE(#9)"~ "KRN",.4,2777,"F",11) 2.4,"ACCOUNTING PERIOD: ";C1;""~2.4,10;X;""~ "KRN",.4,2777,"F",12) 2.4,-200,^VA(200,^^S I(1,0)=D1 S I(0,0)=D0 S DIP(1)=$S($D(^PRC(442,D0,10,D1,0)):^(0),1:"") S X=$P(DIP(1),U,2),X=X S D(0)=+X;Z;"1:"~ "KRN",.4,2777,"F",13) 2.4,-200,"OBLIGATOR'S SVC IEN: ";C40;""~2.4,-200,S DIP(101)=$S($D(^VA(200,D0,5)):^(5),1:"") S X=$P(DIP(101),U,1),X=X W X K DIP;X;"";Z;"INTERNAL(#29)"~ "KRN",.4,2777,"F",14) 2.4,-200,"OBLIGATOR'S SVC: ";C1;""~2.4,-200,29;X;""~" ";C1;""~ "KRN",.4,2777,"H") PO OBLIGATION DATA "KRN",.4,2778,-1) 0^7 "KRN",.4,2778,0) PRCHLO442_2237_VALIDATE^3090427.1558^@^442^^@^3090511 "KRN",.4,2778,"F",1) "POIDNUM: ";C1;""~0;X;""~"PO#: ";C40;""~.01;X;""~"P.O. DATE: ";C1;""~ "KRN",.4,2778,"F",2) S DIP(1)=$S($D(^PRC(442,D0,1)):^(1),1:"") S X=$P(DIP(1),U,15),X=$P(X,".",1) S Y=X D DT K DIP;X;"";d;L18;Z;"DATE(#.1)"~"STATION#: ";C40;""~ "KRN",.4,2778,"F",3) S DIP(1)=$S($D(^PRC(442,D0,0)):^(0),1:"") S X=$P(DIP(1),U,1),DIP(2)=$G(X) S X="-",X=$P(DIP(2),X) W X K DIP;X;"";Z;"$P(#.01,"-")"~.05,"2237 IEN: ";C1;""~ "KRN",.4,2778,"F",4) .05,S DIP(1)=$S($D(^PRC(442,D0,13,D1,0)):^(0),1:"") S X=$P(DIP(1),U,1),X=X W X K DIP;X;"";Z;"INTERNAL(#.01)"~.05,"2237 REFERENCE: ";C40;""~.05,.01;X;""~ "KRN",.4,2778,"F",5) .05,"ACCOUNTABLE OFF: ";C1;""~.05,2;X;""~.05,"DATE SIGNED: ";C40;""~ "KRN",.4,2778,"F",6) .05,S DIP(1)=$S($D(^PRC(442,D0,13,D1,0)):^(0),1:"") S X=$P(DIP(1),U,4),X=$P(X,".",1) S Y=X D DT K DIP;X;"";d;L18;Z;"DATE(#4)"~.05,"PURCHASING AG: ";C1;""~ "KRN",.4,2778,"F",7) .05,6;X;""~.05,"TYPE OF REQUEST: ";C40~.05,S DIP(1)=$S($D(^PRC(442,D0,13,D1,0)):^(0),1:"") S X=$P(DIP(1),U,9),X=X W X K DIP;X;"";Z;"INTERNAL(#9)"~ "KRN",.4,2778,"F",8) .05,"SOURCE OF REQUEST: ";C1;""~.05,S DIP(1)=$S($D(^PRC(442,D0,13,D1,0)):^(0),1:"") S X=$P(DIP(1),U,10),X=X W X K DIP;X;"";Z;"INTERNAL(#10)"~ "KRN",.4,2778,"F",9) .05,"INVENTORY PT: ";C40;""~.05,11;X;""~.05,"PURCHASING AGENT DUZ: ";C1;""~ "KRN",.4,2778,"F",10) .05,S DIP(1)=$S($D(^PRC(442,D0,13,D1,0)):^(0),1:"") S X=$P(DIP(1),U,5),X=X W X K DIP;X;"";Z;"INTERNAL(#6)"~.05,"ACCOUNTABLE OFF DUZ: ";C40;""~ "KRN",.4,2778,"F",11) .05,S DIP(1)=$S($D(^PRC(442,D0,13,D1,0)):^(0),1:"") S X=$P(DIP(1),U,2),X=X W X K DIP;X;"";Z;"INTERNAL(#2)"~ "KRN",.4,2778,"F",12) .05,-200,^VA(200,^^S I(1,0)=D1 S I(0,0)=D0 S DIP(1)=$S($D(^PRC(442,D0,13,D1,0)):^(0),1:"") S X=$P(DIP(1),U,5),X=X S D(0)=+X;Z;"6:"~ "KRN",.4,2778,"F",13) .05,-200,"PA SVC IEN: ";C1;""~.05,-200,S DIP(101)=$S($D(^VA(200,D0,5)):^(5),1:"") S X=$P(DIP(101),U,1),X=X W X K DIP;X;"";Z;"INTERNAL(#29)"~ "KRN",.4,2778,"F",14) .05,-200,"PA SVC: ";C40;""~.05,-200,29;X;""~.05,"";C1;""~ "KRN",.4,2778,"F",15) .05,-200,^VA(200,^^S I(1,0)=D1 S I(0,0)=D0 S DIP(1)=$S($D(^PRC(442,D0,13,D1,0)):^(0),1:"") S X=$P(DIP(1),U,2),X=X S D(0)=+X;Z;"2:"~ "KRN",.4,2778,"F",16) .05,-200,"ACCOUNTABLE OFF SVC IEN: ";C1;""~.05,-200,S DIP(101)=$S($D(^VA(200,D0,5)):^(5),1:"") S X=$P(DIP(101),U,1),X=X W X K DIP;X;"";Z;"INTERNAL(#29)"~ "KRN",.4,2778,"F",17) .05,-200,"ACCOUNTABLE OFF SVC: ";C40;""~.05,-200,29;X;""~" ";C1;""~ "KRN",.4,2778,"H") PO 2237 DATA "KRN",.4,2779,-1) 0^11 "KRN",.4,2779,0) PRCHLO442_BOC_VALIDATE^3090527.1007^@^442^^@^3090527 "KRN",.4,2779,"F",1) "POIDNUM: ";C1;""~0;X;""~"PO#: ";C40;""~.01;X;""~"P.O. DATE: ";C1;""~ "KRN",.4,2779,"F",2) S DIP(1)=$S($D(^PRC(442,D0,1)):^(1),1:"") S X=$P(DIP(1),U,15),X=$P(X,".",1) S Y=X D DT K DIP;X;"";d;L18;Z;"DATE(#.1)"~"STATION#: ";C40;""~ "KRN",.4,2779,"F",3) S DIP(1)=$S($D(^PRC(442,D0,0)):^(0),1:"") S X=$P(DIP(1),U,1),DIP(2)=$G(X) S X="-",X=$P(DIP(2),X) W X K DIP;X;"";Z;"$P(#.01,"-")"~ "KRN",.4,2779,"F",4) 41,"MULTIPLE ENTRY IEN: ";C1;""~41,0;X;""~41,"SUBACCOUNT: ";C40;""~41,.01;X;""~41,"SUBAMOUNT: ";C1;""~ "KRN",.4,2779,"F",5) 41,S DIP(1)=$S($D(^PRC(442,D0,22,D1,0)):^(0),1:"") S X=$P(DIP(1),U,2),X=X W X K DIP;X;"";Z;"INTERNAL(#1)"~41,"FMS LINE: ";C40;""~41,2;X;""~" ";C1;""~ "KRN",.4,2779,"H") PO BOC DATA "KRN",.4,2780,-1) 0^8 "KRN",.4,2780,0) PRCHLO442_AMENDMENT_VALIDATE^3090427.1714^@^442^^@^3090511 "KRN",.4,2780,"F",1) "POIDNUM: ";C1;""~0;X;""~"PO#: ";C40;""~.01;X;""~"P.O. DATE: ";C1;""~ "KRN",.4,2780,"F",2) S DIP(1)=$S($D(^PRC(442,D0,1)):^(1),1:"") S X=$P(DIP(1),U,15),X=$P(X,".",1) S Y=X D DT K DIP;X;"";Z;"DATE(#.1)";d;L18~"STATION#: ";C40;""~ "KRN",.4,2780,"F",3) S DIP(1)=$S($D(^PRC(442,D0,0)):^(0),1:"") S X=$P(DIP(1),U,1),DIP(2)=$G(X) S X="-",X=$P(DIP(2),X) W X K DIP;X;"";Z;"$P(#.01,"-")"~ "KRN",.4,2780,"F",4) 50,"AMENDMENT IEN: ";C1;""~50,0;X;""~50,"AMENDMENT: ";C40;""~50,.01;X;""~50,"EFFECTIVE DATE: ";C1;""~ "KRN",.4,2780,"F",5) 50,S DIP(1)=$S($D(^PRC(442,D0,6,D1,0)):^(0),1:"") S X=$P(DIP(1),U,2),X=$P(X,".",1) S Y=X D DT K DIP;X;"";Z;"DATE(#1)";d;L18~50,"AMT CHANGED: ";C40;""~ "KRN",.4,2780,"F",6) 50,2;X;""~50,"PA/PPM/BUYER: ";C1;""~50,6;X;""~50,"AMENDMENT STATUS: ";C40;""~50,9;X;""~50,"PA/PPM/BUYER'S DUZ: ";C1;""~ "KRN",.4,2780,"F",7) 50,S DIP(1)=$S($D(^PRC(442,D0,6,D1,1)):^(1),1:"") S X=$P(DIP(1),U,1),X=X W X K DIP;X;"";Z;"INTERNAL(#6)"~50,"FISCAL APPR DUZ: ";C1;""~ "KRN",.4,2780,"F",8) 50,S DIP(1)=$S($D(^PRC(442,D0,6,D1,1)):^(1),1:"") S X=$P(DIP(1),U,5),X=X W X K DIP;X;"";Z;"INTERNAL(#10)"~50,"FISCAL APPR: ";C40;""~50,10;X;""~ "KRN",.4,2780,"F",9) 50,-200,^VA(200,^^S I(1,0)=D1 S I(0,0)=D0 S DIP(1)=$S($D(^PRC(442,D0,6,D1,1)):^(1),1:"") S X=$P(DIP(1),U,1),X=X S D(0)=+X;Z;"6:"~ "KRN",.4,2780,"F",10) 50,-200,"PA/PPM/BUYER SVC IEN: ";C1;""~50,-200,S DIP(101)=$S($D(^VA(200,D0,5)):^(5),1:"") S X=$P(DIP(101),U,1),X=X W X K DIP;X;"";Z;"INTERNAL(#29)"~ "KRN",.4,2780,"F",11) 50,-200,"PA/PPM/BUY SVC: ";C40;""~50,-200,29;X;""~50,"";C1;""~ "KRN",.4,2780,"F",12) 50,-200,^VA(200,^^S I(1,0)=D1 S I(0,0)=D0 S DIP(1)=$S($D(^PRC(442,D0,6,D1,1)):^(1),1:"") S X=$P(DIP(1),U,5),X=X S D(0)=+X;Z;"10:"~ "KRN",.4,2780,"F",13) 50,-200,"FISCAL SVC IEN: ";C1;""~50,-200,S DIP(101)=$S($D(^VA(200,D0,5)):^(5),1:"") S X=$P(DIP(101),U,1),X=X W X K DIP;X;"";Z;"INTERNAL(#29)"~ "KRN",.4,2780,"F",14) 50,-200,"FISCAL SVC: ";C40;""~50,-200,29;X;""~" ";C1;""~ "KRN",.4,2780,"H") PO AMENDMENT DATA "KRN",.4,2781,-1) 0^24 "KRN",.4,2781,0) PRCHLO442_PURCH_METH_VALIDATE^3090427.103^@^442^^@^3090511 "KRN",.4,2781,"F",1) "POIDNUM: ";C1;""~0;X;""~"PO#: ";C40;""~.01;X;""~"P.O. DATE: ";C1;""~ "KRN",.4,2781,"F",2) S DIP(1)=$S($D(^PRC(442,D0,1)):^(1),1:"") S X=$P(DIP(1),U,15),X=$P(X,".",1) S Y=X D DT K DIP;X;"";d;L18;Z;"DATE(#.1)"~"STATION#: ";C40;""~ "KRN",.4,2781,"F",3) S DIP(1)=$S($D(^PRC(442,D0,0)):^(0),1:"") S X=$P(DIP(1),U,1),DIP(2)=$G(X) S X="-",X=$P(DIP(2),X) W X K DIP;X;"";Z;"$P(#.01,"-")"~ "KRN",.4,2781,"F",4) 8.3,"PURCHASE METHOD ENTRY#: ";C1;""~8.3,0;X;""~ "KRN",.4,2781,"F",5) 8.3,-442.4,^PRC(442.4,^^S I(1,0)=D1 S I(0,0)=D0 S DIP(1)=$S($D(^PRC(442,D0,14,D1,0)):^(0),1:"") S X=$P(DIP(1),U,1),X=X S D(0)=+X;Z;".01:"~ "KRN",.4,2781,"F",6) 8.3,-442.4,"PURCHASE METHOD DESCRIPTION: ";C1;""~8.3,-442.4,2;X;""~" ";C1;""~ "KRN",.4,2781,"H") PO METHOD OF PURCHASE DATA "KRN",.4,2782,-1) 0^14 "KRN",.4,2782,0) PRCHLO442_DISCOUNT_VALIDATE^3090506.1724^@^442^^@^3090513 "KRN",.4,2782,"F",1) "POIDNUM: ";C1;""~0;X;""~"PO#: ";C40;""~.01;X;""~"P.O. DATE: ";C1;""~ "KRN",.4,2782,"F",2) S DIP(1)=$S($D(^PRC(442,D0,1)):^(1),1:"") S X=$P(DIP(1),U,15),X=$P(X,".",1) S Y=X D DT K DIP;X;"";d;L18;Z;"DATE(#.1)"~"STATION#: ";C40;""~ "KRN",.4,2782,"F",3) S DIP(1)=$S($D(^PRC(442,D0,0)):^(0),1:"") S X=$P(DIP(1),U,1),DIP(2)=$G(X) S X="-",X=$P(DIP(2),X) W X K DIP;X;"";Z;"$P(#.01,"-")"~ "KRN",.4,2782,"F",4) 14,"DISCOUNTIDNUM: ";C1;""~14,0;X;""~14,"DISCOUNT ITEM: ";C40;""~14,.01;X;""~14,"%/$ AMOUNT: ";C1;""~ "KRN",.4,2782,"F",5) 14,S DIP(1)=$S($D(^PRC(442,D0,3,D1,0)):^(0),1:"") S X=$P(DIP(1),U,2),X=X W X K DIP;X;"";Z;"INTERNAL(PERCENT/DOLLAR AMOUNT)"~14,"DISCOUNT AMT: ";C40;""~ "KRN",.4,2782,"F",6) 14,2;X;""~14,"ITEM COUNT: ";C1;""~14,3;X;""~14,"CONTRACT#: ";C40;""~14,4;X;""~14,"LINE ITEM: ";C1;""~14,5;X;""~" ";C1;""~ "KRN",.4,2782,"H") PO DISCOUNT DATA "KRN",.4,2783,-1) 0^19 "KRN",.4,2783,0) PRCHLO442_LINEITEM_VALIDATE^3090427.1205^@^442^^@^3090511 "KRN",.4,2783,"F",1) "POIDNUM: ";C1;""~0;X;""~"PO#: ";C40;""~.01;X;""~"P.O. DATE: ";C1;""~ "KRN",.4,2783,"F",2) S DIP(1)=$S($D(^PRC(442,D0,1)):^(1),1:"") S X=$P(DIP(1),U,15),X=$P(X,".",1) S Y=X D DT K DIP;X;"";d;L18;Z;"DATE(#.1)"~"STATION#: ";C40;""~ "KRN",.4,2783,"F",3) S DIP(1)=$S($D(^PRC(442,D0,0)):^(0),1:"") S X=$P(DIP(1),U,1),DIP(2)=$G(X) S X="-",X=$P(DIP(2),X) W X K DIP;X;"";Z;"$P(#.01,"-")"~ "KRN",.4,2783,"F",4) 40,"ITEM LINE IEN: ";C1;""~40,0;X;""~40,"LINE ITEM#: ";C40;""~40,.01;X;""~40,"IMF#: ";C1;""~40,1.5;X;""~ "KRN",.4,2783,"F",5) 40,-441,^PRC(441,^^S I(1,0)=D1 S I(0,0)=D0 S DIP(1)=$S($D(^PRC(442,D0,2,D1,0)):^(0),1:"") S X=$P(DIP(1),U,5),X=X S D(0)=+X;Z;"1.5:"~ "KRN",.4,2783,"F",6) 40,-441,"IMF SHORT DESCR: ";C1;""~40,-441,.05;X;""~40,-441,"NIF#: ";C1;""~40,-441,51;X;""~40,"QUANTITY: ";C40;""~40,2;X;""~40,"UNIT OF PURCHASE: ";C1;""~ "KRN",.4,2783,"F",7) 40,3;X;""~40,"PKG MULT: ";C40;""~40,3.1;X;""~40,"ITEM DELIV PTS: ";C1;""~40,3.2;X;""~40,"BOC: ";C40;""~40,3.5;X;""~40,"CONTRACT/BOA: ";C1;""~40,4;X;""~ "KRN",.4,2783,"F",8) 40,"ACT UNIT COST: ";C40;""~40,5;X;""~40,"EST UNIT COST: ";C1;""~40,5.5;X;""~40,"FSC: ";C40;""~40,8;X;""~40,"VENDOR STK#: ";C1;""~40,9;X;""~ "KRN",.4,2783,"F",9) 40,"NDC: ";C40;""~40,9.3;X;""~40,"SKU: ";C1;""~40,9.4;X;""~40,"NSN: ";C40;""~40,9.5;X;""~40,"UNIT CONV FACTOR: ";C1;""~40,9.7;X;""~ "KRN",.4,2783,"F",10) 40,"TOTAL COST: ";C40;""~40,15;X;""~40,"DISC AMT: ";C1;""~40,16;X;""~40,"410 ITEM#: ";C40;""~40,43;X;""~40,"LOT#: ";C1;""~40,45;X;""~ "KRN",.4,2783,"F",11) 40,"SERIAL#: ";C40;""~40,46;X;""~" ";C1;""~ "KRN",.4,2783,"H") PO ITEM DATA "KRN",.4,2784,-1) 0^17 "KRN",.4,2784,0) PRCHLO442_ITEM_INVPT_VALIDATE^3090427.1319^@^442^^@^3090511 "KRN",.4,2784,"F",1) "POIDNUM: ";C1;""~0;X;""~"PO#: ";C40;""~.01;X;""~"P.O. DATE: ";C1;""~ "KRN",.4,2784,"F",2) S DIP(1)=$S($D(^PRC(442,D0,1)):^(1),1:"") S X=$P(DIP(1),U,15),X=$P(X,".",1) S Y=X D DT K DIP;X;"";Z;"DATE(#.1)";d;L18~"STATION#: ";C40;""~ "KRN",.4,2784,"F",3) S DIP(1)=$S($D(^PRC(442,D0,0)):^(0),1:"") S X=$P(DIP(1),U,1),DIP(2)=$G(X) S X="-",X=$P(DIP(2),X) W X K DIP;X;"";Z;"$P(#.01,"-")"~ "KRN",.4,2784,"F",4) 40,"ITEM LINE IEN: ";C1;""~40,0;X;""~40,47,"LINE INVPT IEN: ";C40;""~40,47,0;X;""~40,47,"LINE INVPT: ";C1;""~40,47,.01;X;""~40,47,"LINE QTY: ";C40;""~ "KRN",.4,2784,"F",5) 40,47,1;X;""~40,47,"LINE DELIVERY: ";C1;""~40,47,2;X;""~40,47,"QTY RECV TO DATE: ";C40;""~40,47,3;X;""~" ";C1;""~ "KRN",.4,2784,"H") PO ITEM INVENTORY POINT DATA "KRN",.4,2786,-1) 0^18 "KRN",.4,2786,0) PRCHLO442_ITEM_RECV_VALIDATE^3090427.1339^@^442^^@^3090511 "KRN",.4,2786,"F",1) "POIDNUM: ";C1;""~0;X;""~"PO#: ";C40;""~.01;X;""~"P.O. DATE: ";C1;""~ "KRN",.4,2786,"F",2) S DIP(1)=$S($D(^PRC(442,D0,1)):^(1),1:"") S X=$P(DIP(1),U,15),X=$P(X,".",1) S Y=X D DT K DIP;X;"";Z;"DATE(#.1)";d;L18~"STATION#: ";C40;""~ "KRN",.4,2786,"F",3) S DIP(1)=$S($D(^PRC(442,D0,0)):^(0),1:"") S X=$P(DIP(1),U,1),DIP(2)=$G(X) S X="-",X=$P(DIP(2),X) W X K DIP;X;"";Z;"$P(#.01,"-")"~ "KRN",.4,2786,"F",4) 40,"ITEM LINE IEN: ";C1;""~40,0;X;""~40,20,"DATE RECV IEN: ";C1;""~40,20,0;X;""~40,20,"DATE RECEIVED: ";C40;""~ "KRN",.4,2786,"F",5) 40,20,S DIP(1)=$S($D(^PRC(442,D0,2,D1,3,D2,0)):^(0),1:"") S X=$P(DIP(1),U,1),X=$P(X,".",1) S Y=X D DT K DIP;X;"";Z;"DATE(#.01)";d;L18~ "KRN",.4,2786,"F",6) 40,20,"QTY RECV: ";C1;""~40,20,1;X;""~40,20,"AMOUNT: ";C40;""~40,20,2;X;""~40,20,"PARTIAL#: ";C1;""~40,20,3;X;""~40,20,"DISCOUNTED AMT: ";C40;""~ "KRN",.4,2786,"F",7) 40,20,4;X;""~40,20,"ADJ QTY RECV: ";C1;""~40,20,6;X;""~40,20,"ADJ AMOUNT: ";C40;""~40,20,7;X;""~" ";C1;""~ "KRN",.4,2786,"H") PO ITEM DATE RECEIVED DATA "KRN",.4,2787,-1) 0^21 "KRN",.4,2787,0) PRCHLO442_PARTIAL_VALIDATE^3090427.1506^@^442^^@^3090511 "KRN",.4,2787,"F",1) "POIDNUM: ";C1;""~0;X;""~"PO#: ";C40;""~.01;X;""~"P.O. DATE: ";C1;""~ "KRN",.4,2787,"F",2) S DIP(1)=$S($D(^PRC(442,D0,1)):^(1),1:"") S X=$P(DIP(1),U,15),X=$P(X,".",1) S Y=X D DT K DIP;X;"";d;L18;Z;"DATE(#.1)"~"STATION#: ";C40;""~ "KRN",.4,2787,"F",3) S DIP(1)=$S($D(^PRC(442,D0,0)):^(0),1:"") S X=$P(DIP(1),U,1),DIP(2)=$G(X) S X="-",X=$P(DIP(2),X) W X K DIP;X;"";Z;"$P(#.01,"-")"~ "KRN",.4,2787,"F",4) .6,"PARTIALIDNUM: ";C1;""~.6,0;X;""~.6,"DATE: ";C40;""~ "KRN",.4,2787,"F",5) .6,S DIP(1)=$S($D(^PRC(442,D0,11,D1,0)):^(0),1:"") S X=$P(DIP(1),U,1),X=$P(X,".",1) S Y=X D DT K DIP;X;"";d;L18;Z;"DATE(#.01)"~ "KRN",.4,2787,"F",6) .6,"SCHED DELIVERY DATE: ";C1;""~ "KRN",.4,2787,"F",7) .6,S DIP(1)=$S($D(^PRC(442,D0,11,D1,1)):^(1),1:"") S X=$P(DIP(1),U,8),X=$P(X,".",1) S Y=X D DT K DIP;X;"";d;L18;Z;"DATE(#.05)"~.6,"SUBACCNT1: ";C1;""~ "KRN",.4,2787,"F",8) .6,1;X;""~.6,"SUBAMT1: ";C40;""~.6,2;X;""~.6,"SUBACCNT2: ";C1;""~.6,3;X;""~.6,"SUBAMT2: ";C40;""~.6,4;X;""~.6,"FINAL: ";C1;""~ "KRN",.4,2787,"F",9) .6,S DIP(1)=$S($D(^PRC(442,D0,11,D1,0)):^(0),1:"") S X=$P(DIP(1),U,9),X=X W X K DIP;X;"";Z;"INTERNAL(#8)"~.6,"OVERAGE: ";C40;""~.6,9;X;""~ "KRN",.4,2787,"F",10) .6,"TOTAL AMT: ";C1;""~.6,11;X;""~.6,"DISCOUNT %/DAYS: ";C40;""~.6,12;X;""~.6,"LINE COUNT: ";C1;""~.6,13;X;""~.6,"ORIGINAL PARTIAL: ";C40;""~.6,21;X;""~ "KRN",.4,2787,"F",11) .6,"ADJ/AMENDMENT#: ";C1;""~.6,24;X;""~" ";C1;""~ "KRN",.4,2787,"H") PO PARTIAL DATA "KRN",.4,2790,-1) 0^23 "KRN",.4,2790,0) PRCHLO442_PROMPT_PAY_VALIDATE^3090427.1643^@^442^^@^3090512 "KRN",.4,2790,"F",1) "POIDNUM: ";C1;""~0;X;""~"PO#: ";C40;""~.01;X;""~"P.O. DATE: ";C1;""~ "KRN",.4,2790,"F",2) S DIP(1)=$S($D(^PRC(442,D0,1)):^(1),1:"") S X=$P(DIP(1),U,15),X=$P(X,".",1) S Y=X D DT K DIP;X;"";Z;"DATE(#.1)";d;L18~"STATION#: ";C40;""~ "KRN",.4,2790,"F",3) S DIP(1)=$S($D(^PRC(442,D0,0)):^(0),1:"") S X=$P(DIP(1),U,1),DIP(2)=$G(X) S X="-",X=$P(DIP(2),X) W X K DIP;X;"";Z;"$P(#.01,"-")"~ "KRN",.4,2790,"F",4) 9.2,"PAYMENT TERMS ID#: ";C1;""~9.2,0;X;""~9.2,"PROMPT PAYMENT %: ";C40;""~9.2,.01;X;""~9.2,"DAYS (TERM): ";C1;""~9.2,1;X;""~9.2,"CONTRACT#: ";C40;""~ "KRN",.4,2790,"F",5) 9.2,2;X;""~9.2,"ASTR: ";C1;""~9.2,3;X;""~" ";C1;""~ "KRN",.4,2790,"H") PO PROMPT PAYMENT TERMS DATA "KRN",.4,2791,-1) 0^22 "KRN",.4,2791,0) PRCHLO442_PO_AMT_VALIDATE^3090427.1702^@^442^^@^3090511 "KRN",.4,2791,"F",1) "POIDNUM: ";C1;""~0;X;""~"PO#: ";C40;""~.01;X;""~"P.O. DATE: ";C1;""~ "KRN",.4,2791,"F",2) S DIP(1)=$S($D(^PRC(442,D0,1)):^(1),1:"") S X=$P(DIP(1),U,15),X=$P(X,".",1) S Y=X D DT K DIP;X;"";Z;"DATE(#.1)";d;L18~"STATION#: ";C40;""~ "KRN",.4,2791,"F",3) S DIP(1)=$S($D(^PRC(442,D0,0)):^(0),1:"") S X=$P(DIP(1),U,1),DIP(2)=$G(X) S X="-",X=$P(DIP(2),X) W X K DIP;X;"";Z;"$P(#.01,"-")"~35,"AMOUNT ID#: ";C1;""~ "KRN",.4,2791,"F",4) 35,0;X;""~35,"AMOUNT: ";C40;""~35,.01;X;""~35,"TYPE CODE: ";C1;""~35,1;X;""~35,"COMP. STATUS/BUSINESS: ";C40;""~35,1.1;X;""~35,"PREF PROGRAM: ";C1;""~ "KRN",.4,2791,"F",5) 35,1.2;X;""~35,"CONTRACT#: ";C40;""~35,2;X;""~" ";C1;""~ "KRN",.4,2791,"H") PO AMOUNT DATA "KRN",.4,2792,-1) 0^9 "KRN",.4,2792,0) PRCHLO442_AMEND_CHG_VALIDATE^3090427.1757^@^442^^@^3090511 "KRN",.4,2792,"F",1) "POIDNUM: ";C1;""~0;X;""~"PO#: ";C40;""~.01;X;""~"P.O. DATE: ";C1;""~ "KRN",.4,2792,"F",2) S DIP(1)=$S($D(^PRC(442,D0,1)):^(1),1:"") S X=$P(DIP(1),U,15),X=$P(X,".",1) S Y=X D DT K DIP;X;"";Z;"DATE(#.1)";d;L18~"STATION#: ";C40;""~ "KRN",.4,2792,"F",3) S DIP(1)=$S($D(^PRC(442,D0,0)):^(0),1:"") S X=$P(DIP(1),U,1),DIP(2)=$G(X) S X="-",X=$P(DIP(2),X) W X K DIP;X;"";Z;"$P(#.01,"-")"~ "KRN",.4,2792,"F",4) 50,"AMENDMENT ID#: ";C1;""~50,0;X;""~50,14,"CHANGES ID#: ";C1;""~50,14,0;X;""~50,14,"CHANGES: ";C40;""~50,14,.01;X;""~50,14,"AMENDMENT TYPE: ";C1;""~ "KRN",.4,2792,"F",5) 50,14,1;X;""~" ";C1;""~ "KRN",.4,2792,"H") PO AMENDMENT CHANGES DATA "KRN",.4,2794,-1) 0^12 "KRN",.4,2794,0) PRCHLO442_BREAKOUT_C_VALIDATE^3090427.1815^@^442^^@^3090511 "KRN",.4,2794,"F",1) "POIDNUM: ";C1;""~0;X;""~"PO#: ";C40;""~.01;X;""~"P.O. DATE: ";C1;""~ "KRN",.4,2794,"F",2) S DIP(1)=$S($D(^PRC(442,D0,1)):^(1),1:"") S X=$P(DIP(1),U,15),X=$P(X,".",1) S Y=X D DT K DIP;X;"";Z;"DATE(#.1)";d;L18~"STATION#: ";C40;""~ "KRN",.4,2794,"F",3) S DIP(1)=$S($D(^PRC(442,D0,0)):^(0),1:"") S X=$P(DIP(1),U,1),DIP(2)=$G(X) S X="-",X=$P(DIP(2),X) W X K DIP;X;"";Z;"$P(#.01,"-")"~35,"AMOUNT ID#: ";C1;""~ "KRN",.4,2794,"F",4) 35,0;X;""~35,3,"BREAKOUT CODE ID#: ";C1~35,3,0;X;""~35,3,"BREAKOUT CODE: ";C40;""~35,3,.01;X;""~" ";C1;""~ "KRN",.4,2794,"H") PO AMOUNT BREAKOUT CODE DATA "KRN",.4,2795,-1) 0^13 "KRN",.4,2795,0) PRCHLO442_COMMENTS1ST_VALIDATE^3090424.1418^@^442^^@^3090511 "KRN",.4,2795,"DXS",1,9.2) F D=0:0 S (D,D1)=$O(^PRC(442,D0,4,D)) Q:D'>0 I $D(^(D,0))#2 S X=^(0) S Y=X S:Y'?." " DIP(2)=DIP(2)+1 I DIP(2)=1,Y'?." " S DIP(1)=Y Q Q:'$D(D) S D=D1 "KRN",.4,2795,"DXS",1,9.3) S I(1,0)=$G(D1) X DXS(1,9.2):D0>0 S X="" S D1=I(1,0) "KRN",.4,2795,"F",1) "POIDNUM: ";C1;""~0;X;""~"PO#: ";C40;""~.01;X;""~"P.O. DATE: ";C1;""~ "KRN",.4,2795,"F",2) S DIP(1)=$S($D(^PRC(442,D0,1)):^(1),1:"") S X=$P(DIP(1),U,15),X=$P(X,".",1) S Y=X D DT K DIP;X;"";Z;"DATE(#.1)";d;L18~"STATION#: ";C40;""~ "KRN",.4,2795,"F",3) S DIP(1)=$S($D(^PRC(442,D0,0)):^(0),1:"") S X=$P(DIP(1),U,1),DIP(2)=$G(X) S X="-",X=$P(DIP(2),X) W X K DIP;X;"";Z;"$P(#.01,"-")"~"COMMENTS: ";C1;""~ "KRN",.4,2795,"F",4) S DIP(2)=0 S DIP(1)="" X DXS(1,9.3) S X=DIP(1) W X K DIP;X;"";Z;"1ST(COMMENTS)"~" ";C1;""~ "KRN",.4,2795,"H") PO COMMENTS DATA "KRN",.4,2796,-1) 0^10 "KRN",.4,2796,0) PRCHLO442_AMEND_DESCR1ST_VALID^3090424.1432^@^442^^@^3090511 "KRN",.4,2796,"DXS",1,9.2) F D=0:0 S (D,D2)=$O(^PRC(442,D0,6,D1,2,D)) Q:D'>0 I $D(^(D,0))#2 S X=^(0) S Y=X S:Y'?." " DIP(2)=DIP(2)+1 I DIP(2)=1,Y'?." " S DIP(1)=Y Q Q:'$D(D) S D=D2 "KRN",.4,2796,"DXS",1,9.3) S I(2,0)=$G(D2) X DXS(1,9.2):D1>0 S X="" S D2=I(2,0) "KRN",.4,2796,"F",1) "POIDNUM: ";C1;""~0;X;""~"PO#: ";C40;""~.01;X;""~"P.O. DATE: ";C1;""~ "KRN",.4,2796,"F",2) S DIP(1)=$S($D(^PRC(442,D0,1)):^(1),1:"") S X=$P(DIP(1),U,15),X=$P(X,".",1) S Y=X D DT K DIP;X;"";Z;"DATE(#.1)";d;L18~"STATION#: ";C40;""~ "KRN",.4,2796,"F",3) S DIP(1)=$S($D(^PRC(442,D0,0)):^(0),1:"") S X=$P(DIP(1),U,1),DIP(2)=$G(X) S X="-",X=$P(DIP(2),X) W X K DIP;X;"";Z;"$P(#.01,"-")"~ "KRN",.4,2796,"F",4) 50,"AMENDMENT ID#: ";C1;""~50,0;X;""~50,"DESCRIPTION: ";C1;""~50,S DIP(2)=0 S DIP(1)="" X DXS(1,9.3) S X=DIP(1) W X K DIP;X;"";Z;"1ST(DESCRIPTION)"~ "KRN",.4,2796,"F",5) " ";C1;""~ "KRN",.4,2796,"H") PO AMENDMENT DESCRIPTION DATA "KRN",.4,2797,-1) 0^16 "KRN",.4,2797,0) PRCHLO442_ITEM_DESC1ST_VALID^3090424.1557^@^442^^@^3090511 "KRN",.4,2797,"DXS",1,9.2) F D=0:0 S (D,D2)=$O(^PRC(442,D0,2,D1,1,D)) Q:D'>0 I $D(^(D,0))#2 S X=^(0) S Y=X S:Y'?." " DIP(2)=DIP(2)+1 I DIP(2)=1,Y'?." " S DIP(1)=Y Q Q:'$D(D) S D=D2 "KRN",.4,2797,"DXS",1,9.3) S I(2,0)=$G(D2) X DXS(1,9.2):D1>0 S X="" S D2=I(2,0) "KRN",.4,2797,"F",1) "POIDNUM: ";C1;""~0;X;""~"PO#: ";C40;""~.01;X;""~"P.O. DATE: ";C1;""~ "KRN",.4,2797,"F",2) S DIP(1)=$S($D(^PRC(442,D0,1)):^(1),1:"") S X=$P(DIP(1),U,15),X=$P(X,".",1) S Y=X D DT K DIP;X;"";Z;"DATE(#.1)";d;L18~"STATION#: ";C40;""~ "KRN",.4,2797,"F",3) S DIP(1)=$S($D(^PRC(442,D0,0)):^(0),1:"") S X=$P(DIP(1),U,1),DIP(2)=$G(X) S X="-",X=$P(DIP(2),X) W X K DIP;X;"";Z;"$P(#.01,"-")"~ "KRN",.4,2797,"F",4) 40,"ITEM LINE IEN: ";C1;""~40,0;X;""~40,"DESCRIPTION: ";C1;""~40,S DIP(2)=0 S DIP(1)="" X DXS(1,9.3) S X=DIP(1) W X K DIP;X;"";Z;"1ST(DESCRIPTION)"~ "KRN",.4,2797,"F",5) " ";C1;""~ "KRN",.4,2797,"H") PO ITEM DESC DATA "KRN",.4,2798,-1) 0^25 "KRN",.4,2798,0) PRCHLO442_REMARKS_1ST_VALIDATE^3090424.1621^@^442^^@^3090511 "KRN",.4,2798,"DXS",1,9.2) F D=0:0 S (D,D1)=$O(^PRC(442,D0,16,D)) Q:D'>0 I $D(^(D,0))#2 S X=^(0) S Y=X S:Y'?." " DIP(2)=DIP(2)+1 I DIP(2)=1,Y'?." " S DIP(1)=Y Q Q:'$D(D) S D=D1 "KRN",.4,2798,"DXS",1,9.3) S I(1,0)=$G(D1) X DXS(1,9.2):D0>0 S X="" S D1=I(1,0) "KRN",.4,2798,"F",1) "POIDNUM: ";C1;""~0;X;""~"PO#: ";C40;""~.01;X;""~"P.O. DATE: ";C1;""~ "KRN",.4,2798,"F",2) S DIP(1)=$S($D(^PRC(442,D0,1)):^(1),1:"") S X=$P(DIP(1),U,15),X=$P(X,".",1) S Y=X D DT K DIP;X;"";Z;"DATE(#.1)";d;L18~"STATION#: ";C40;""~ "KRN",.4,2798,"F",3) S DIP(1)=$S($D(^PRC(442,D0,0)):^(0),1:"") S X=$P(DIP(1),U,1),DIP(2)=$G(X) S X="-",X=$P(DIP(2),X) W X K DIP;X;"";Z;"$P(#.01,"-")"~"REMARKS: ";C1;""~ "KRN",.4,2798,"F",4) S DIP(2)=0 S DIP(1)="" X DXS(1,9.3) S X=DIP(1) W X K DIP;X;"";Z;"1ST(REMARKS)"~" ";C1;""~ "KRN",.4,2798,"H") PO REMARKS DATA "KRN",.4,2800,-1) 0^1 "KRN",.4,2800,0) PRC 1358 SEPARATION VIOL^3090501.1249^@^410^^@^3090708 "KRN",.4,2800,"F",1) .01;L19;C1;"TRANSACTION#"~ "KRN",.4,2800,"F",2) S DIP(1)=$S($D(^PRCS(410,D0,7)):^(7),1:"") S X=$P(DIP(1),U,5) S:X X=$E(X,4,5)_"/"_$E(X,6,7)_"/"_$E(X,2,3) W X K DIP;C20;"DATE APPROVED";Z;"NUMDATE(DATE SIGNED (APPROVED))"~ "KRN",.4,2800,"F",3) 40;L15;C30~42;L15;C47~29;L15;C65~52;C4;"OBLIGATION"~27;C16;"$ AMT"~1;L5;C30;"TYPE"~ "KRN",.4,2800,"H") 1358 SEPARATION OF DUTIES VIOLATIONS "KRN",.4,2801,-1) 0^2 "KRN",.4,2801,0) PRC 1358 MISSING FIELDS^3090504.124^@^410^^@^3090708 "KRN",.4,2801,"F",1) .01;C1;"TRANS#"~1;L5;C20;"TYPE"~27;C30;"$ AMT"~ "KRN",.4,2801,"F",2) S DIP(1)=$S($D(^PRCS(410,D0,7)):^(7),1:"") S X=$P(DIP(1),U,5) S:X X=$E(X,4,5)_"/"_$E(X,6,7)_"/"_$E(X,2,3) W X K DIP;L10;C50;"DATE APPROVED";Z;"NUMDATE(DATE SIGNED (APPROVED))"~ "KRN",.4,2801,"F",3) 52;L12;C68;"OBLIGATION#"~40;C5~"VENDOR: ";C5;""~11;X;""~"CONTRACT: ";C50;""~13;X;""~"PURPOSE: ";C10;""~45,.01;X;""~ "KRN",.4,2801,"H") 1358 TRANSACTIONS MISSING CRITICAL FIELDS "KRN",.401,2027,-1) 0^1 "KRN",.401,2027,0) PRC SEPARATION VIOLATE^3090430.105^@^410^^@^3090708 "KRN",.401,2027,2,0) ^.4014^3^3 "KRN",.401,2027,2,1,0) 410^44^DATE SIGNED (APPROVED)^@^^^^^^1 "KRN",.401,2027,2,1,"ASK") 1 "KRN",.401,2027,2,1,"F") 3090706.999999^T-1^Jul 7,2009 "KRN",.401,2027,2,1,"GET") S DISX(1)=$P($G(^PRCS(410,D0,7)),U,5) "KRN",.401,2027,2,1,"QCON") I (DISX(1)]]3090706.999999)&(DISX(1)']]3090707.24) "KRN",.401,2027,2,1,"SER") 1.0000^1.0000 "KRN",.401,2027,2,1,"T") 3090707.24^T-1@2400^Jul 7,2009@24:00 "KRN",.401,2027,2,1,"TXT") DATE SIGNED (APPROVED) from Jul 7,2009 to Jul 7,2009@24:00 "KRN",.401,2027,2,2,0) 410^^FORM TYPE^@"3^^^^^^4 "KRN",.401,2027,2,2,"CM") S Y(1)=$S($D(^PRCS(410,D0,0)):^(0),1:"") S X=$P($G(^PRCS(410.5,+$P(Y(1),U,4),0)),U) I D0>0 S DISX(2)=X "KRN",.401,2027,2,2,"F") 1358 ORDEQz^1358 ORDER "KRN",.401,2027,2,2,"GET") S Y(1)=$S($D(^PRCS(410,D0,0)):^(0),1:"") S X=$P($G(^PRCS(410.5,+$P(Y(1),U,4),0)),U) I D0>0 S DISX(2)=X "KRN",.401,2027,2,2,"QCON") I DISX(2)="1358 ORDER" "KRN",.401,2027,2,2,"T") 1358 ORDER^1358 ORDER "KRN",.401,2027,2,2,"TXT") FORM TYPE equals 1358 ORDER "KRN",.401,2027,2,3,0) 410^^(REQUESTOR=APPROVING OFFICIAL)!(REQUESTOR=OBLIGATED BY)!(APPROVING OFFICIAL=OBLIGATED BY)^"@B^;L1^^^^^4 "KRN",.401,2027,2,3,3,0) ^.401419^2^2 "KRN",.401,2027,2,3,3,1,0) OVF0^9.2 "KRN",.401,2027,2,3,3,1,"OVF0") S Y(3)=$S($D(^PRCS(410,D0,4)):^(4),1:""),Y(1)=$S($D(^PRCS(410,D0,7)):^(7),1:"") S X=$P($G(^VA(200,+$P(Y(1),U,1),0)),U)=$P($G(^VA(200,+$P(Y(1),U,3),0)),U) "KRN",.401,2027,2,3,3,2,0) OVF0^9.3 "KRN",.401,2027,2,3,3,2,"OVF0") X DPP(3,"OVF0",9.2) S Y(2)=$G(X) S X=$P($G(^VA(200,+$P(Y(1),U,1),0)),U)=$P($G(^VA(200,+$P(Y(3),U,9),0)),U),Y=X,X=Y(2),X=X!Y,Y(4)=$G(X) "KRN",.401,2027,2,3,3,"B","OVF0",1) "KRN",.401,2027,2,3,3,"B","OVF0",2) "KRN",.401,2027,2,3,"CM") X DPP(3,"OVF0",9.3) S X=$P($G(^VA(200,+$P(Y(1),U,3),0)),U)=$P($G(^VA(200,+$P(Y(3),U,9),0)),U),Y=X,X=Y(4),X=X!Y I D0>0 S DISX(3)=X "KRN",.401,2027,2,3,"F") 0 "KRN",.401,2027,2,3,"GET") X DPP(3,"OVF0",9.3) S X=$P($G(^VA(200,+$P(Y(1),U,3),0)),U)=$P($G(^VA(200,+$P(Y(3),U,9),0)),U),Y=X,X=Y(4),X=X!Y I D0>0 S DISX(3)=X "KRN",.401,2027,2,3,"QCON") I DISX(3) "KRN",.401,2027,2,3,"T") 1 "KRN",.401,2027,2,3,"TXT") (REQUESTOR=APPROVING OFFICIAL)!(REQUESTOR=OBLIGATED BY)!(APPROVING OFFICIAL=OBLIGATED BY) "KRN",.401,2027,2,"B",410,1) "KRN",.401,2027,2,"B",410,2) "KRN",.401,2027,2,"B",410,3) "KRN",.401,2027,"%D",0) ^.4012^1^1^3090430^^^ "KRN",.401,2027,"%D",1,0) Identifies violations of separation of duties for 1358s. "KRN",.401,2031,-1) 0^2 "KRN",.401,2031,0) PRC MISSING 1358 FIELDS^3090506.1136^@^410^^@^3090708 "KRN",.401,2031,2,0) ^.4014^4^4 "KRN",.401,2031,2,1,0) 410^^FORM TYPE^@"3^^^^^^4 "KRN",.401,2031,2,1,"CM") S Y(1)=$S($D(^PRCS(410,D0,0)):^(0),1:"") S X=$P($G(^PRCS(410.5,+$P(Y(1),U,4),0)),U) I D0>0 S DISX(1)=X "KRN",.401,2031,2,1,"F") 1358 ORDEQz^1358 ORDER "KRN",.401,2031,2,1,"GET") S Y(1)=$S($D(^PRCS(410,D0,0)):^(0),1:"") S X=$P($G(^PRCS(410.5,+$P(Y(1),U,4),0)),U) I D0>0 S DISX(1)=X "KRN",.401,2031,2,1,"QCON") I DISX(1)="1358 ORDER" "KRN",.401,2031,2,1,"T") 1358 ORDER^1358 ORDER "KRN",.401,2031,2,1,"TXT") FORM TYPE equals 1358 ORDER "KRN",.401,2031,2,2,0) 410^^(CONTROL POINT+0)^@"^^^^^^4 "KRN",.401,2031,2,2,"CM") S Y(1)=$S($D(^PRCS(410,D0,3)):^(3),1:"") S X=$P(Y(1),U,1)+0 I D0>0 S DISX(2)=X "KRN",.401,2031,2,2,"F") ?z^@ "KRN",.401,2031,2,2,"GET") S Y(1)=$S($D(^PRCS(410,D0,3)):^(3),1:"") S X=$P(Y(1),U,1)+0 I D0>0 S DISX(2)=X "KRN",.401,2031,2,2,"QCON") I 1 "KRN",.401,2031,2,2,"T") z^ "KRN",.401,2031,2,2,"TXT") All (CONTROL POINT+0) (includes nulls) "KRN",.401,2031,2,3,0) 410^44^DATE SIGNED (APPROVED)^@^^^^^^1 "KRN",.401,2031,2,3,"ASK") 1 "KRN",.401,2031,2,3,"F") 3090706.999999^T-1^Jul 7,2009 "KRN",.401,2031,2,3,"GET") S DISX(3)=$P($G(^PRCS(410,D0,7)),U,5) "KRN",.401,2031,2,3,"QCON") I (DISX(3)]]3090706.999999)&(DISX(3)']]3090707.24) "KRN",.401,2031,2,3,"SER") 1.0000^1.0000 "KRN",.401,2031,2,3,"T") 3090707.24^T-1@2400^Jul 7,2009@24:00 "KRN",.401,2031,2,3,"TXT") DATE SIGNED (APPROVED) from Jul 7,2009 to Jul 7,2009@24:00 "KRN",.401,2031,2,4,0) 410^^(VENDOR="")!(VENDOR CONTRACT NUMBER="")!(COUNT(#45)'>0)^"@B^;L1^^^^^4 "KRN",.401,2031,2,4,3,0) ^.401419^3^3 "KRN",.401,2031,2,4,3,1,0) OVF0^9.2 "KRN",.401,2031,2,4,3,1,"OVF0") F D=0:0 S (D,D1)=$O(^PRCS(410,D0,8,D)) Q:D'>0 I $D(^(D,0))#2 S X=^(0) S:X'?." " Y(6)=Y(6)+1 Q:'$D(D) S D=D1 "KRN",.401,2031,2,4,3,2,0) OVF0^9.3 "KRN",.401,2031,2,4,3,2,"OVF0") S I(1,0)=$G(D1) X DPP(4,"OVF0",9.2):D0>0 S X="" S D1=I(1,0) "KRN",.401,2031,2,4,3,3,0) OVF0^9.4 "KRN",.401,2031,2,4,3,3,"OVF0") S Y(1)=$S($D(^PRCS(410,D0,2)):^(2),1:""),Y(3)=$S($D(^PRCS(410,D0,3)):^(3),1:"") S X=$P(Y(1),U,1)="",Y(2)=$G(X) S X=$P(Y(3),U,10)="",Y=X,X=Y(2),X=X!Y "KRN",.401,2031,2,4,3,"B","OVF0",1) "KRN",.401,2031,2,4,3,"B","OVF0",2) "KRN",.401,2031,2,4,3,"B","OVF0",3) "KRN",.401,2031,2,4,"CM") X DPP(4,"OVF0",9.4) S Y(4)=$G(X),Y(5)=$G(X),Y(6)="" X DPP(4,"OVF0",9.3) S X=+Y(6)'>0,Y=X,X=Y(4),X=X!Y I D0>0 S DISX(4)=X "KRN",.401,2031,2,4,"F") 0 "KRN",.401,2031,2,4,"GET") X DPP(4,"OVF0",9.4) S Y(4)=$G(X),Y(5)=$G(X),Y(6)="" X DPP(4,"OVF0",9.3) S X=+Y(6)'>0,Y=X,X=Y(4),X=X!Y I D0>0 S DISX(4)=X "KRN",.401,2031,2,4,"QCON") I DISX(4) "KRN",.401,2031,2,4,"T") 1 "KRN",.401,2031,2,4,"TXT") (VENDOR="""")!(VENDOR CONTRACT NUMBER="""")!(COUNT(#45)'>0) "KRN",.401,2031,2,"B",410,1) "KRN",.401,2031,2,"B",410,2) "KRN",.401,2031,2,"B",410,3) "KRN",.401,2031,2,"B",410,4) "KRN",.401,2031,"%D",0) ^.4012^3^3^3090506^^^ "KRN",.401,2031,"%D",1,0) This sort identifies 1358 request/adjustment entries within a date range "KRN",.401,2031,"%D",2,0) that are missing critical fields of vendor, vendor contract, or "KRN",.401,2031,"%D",3,0) justification (purpose). "KRN",3.8,352,-1) 0^1 "KRN",3.8,352,0) PRC 1358 MONITORS^PU^n^^^^ "KRN",3.8,352,2,0) ^3.801^2^2^3090507^^ "KRN",3.8,352,2,1,0) This mail group contains staff monitoring compliance to policies for 1358 "KRN",3.8,352,2,2,0) Miscellaneous Obligation usage. "KRN",3.8,352,3) "KRN",19,10347,-1) 2^2 "KRN",19,10347,0) PRCHUSER COORDINATOR^IFCAP Application Coordinator Menu^^M^68^^^^^^^455 "KRN",19,10347,10,0) ^19.01IP^20^20 "KRN",19,10347,10,16,0) 12151 "KRN",19,10347,10,16,"^") PRCPLO CLO MENU "KRN",19,10347,10,20,0) 12740 "KRN",19,10347,10,20,"^") PRC 1358 COMPLIANCE REPORTS "KRN",19,10347,"U") IFCAP APPLICATION COORDINATOR "KRN",19,12151,-1) 2^7 "KRN",19,12151,0) PRCPLO CLO MENU^Clinical Logistics Office Menu^^M^2429^^^^^^^455 "KRN",19,12151,10,0) ^19.01IP^4^4 "KRN",19,12151,10,4,0) 12741 "KRN",19,12151,10,4,"^") PRCHLO CLRS VALIDATION "KRN",19,12151,"U") CLINICAL LOGISTICS OFFICE MENU "KRN",19,12737,-1) 0^6 "KRN",19,12737,0) PRC 1358 MONITORING^1358 Monitoring Reports - Scheduled^^R^^^^^^^^IFCAP "KRN",19,12737,1,0) ^19.06^4^4^3090507^^^ "KRN",19,12737,1,1,0) This scheduled option runs reports on 1358 obligation and adjustment "KRN",19,12737,1,2,0) requests to identify those which violate policy. The reports are "KRN",19,12737,1,3,0) loaded into MailMan messages and sent to the PRC 1358 MONITORS mail "KRN",19,12737,1,4,0) group monitoring compliance. "KRN",19,12737,25) IN1^PRC1358C "KRN",19,12737,200.9) y "KRN",19,12737,"U") 1358 MONITORING REPORTS - SCHE "KRN",19,12738,-1) 0^5 "KRN",19,12738,0) PRC 1358 SEPARATION VIOL^Separation of Duties Violations Report (1358)^^R^^^^^^^^IFCAP "KRN",19,12738,1,0) ^19.06^4^4^3090512^^^^ "KRN",19,12738,1,1,0) This option runs a report to identify 1358 obligation and adjustment "KRN",19,12738,1,2,0) requests where an individual has signed in more than one of the "KRN",19,12738,1,3,0) following roles: Requestor (clerk), Control Point Official Approver, or "KRN",19,12738,1,4,0) Fiscal Obligator. This would violate the policy of separation of duties. "KRN",19,12738,25) IN3^PRC1358C "KRN",19,12738,"U") SEPARATION OF DUTIES VIOLATION "KRN",19,12739,-1) 0^4 "KRN",19,12739,0) PRC 1358 MISSING FIELDS^Missing Fields Report (1358)^^R^^^^^^^^IFCAP "KRN",19,12739,1,0) ^19.06^4^4^3090512^^^ "KRN",19,12739,1,1,0) This option runs a report to identify 1358 obligation and adjustment "KRN",19,12739,1,2,0) requests where the vendor (field #11), the vendor's contract (field #13) "KRN",19,12739,1,3,0) or the purpose (justification field #45) of the 1358 transaction is not "KRN",19,12739,1,4,0) populated. "KRN",19,12739,25) IN4^PRC1358C "KRN",19,12739,"U") MISSING FIELDS REPORT (1358) "KRN",19,12740,-1) 0^3 "KRN",19,12740,0) PRC 1358 COMPLIANCE REPORTS^Compliance Reports (1358)^^M^^^^^^^^IFCAP "KRN",19,12740,1,0) ^^2^2^3090505^ "KRN",19,12740,1,1,0) This menu contains reports that can be used to monitor compliance with "KRN",19,12740,1,2,0) policy on the use of 1358s. "KRN",19,12740,10,0) ^19.01IP^2^2 "KRN",19,12740,10,1,0) 12738 "KRN",19,12740,10,1,"^") PRC 1358 SEPARATION VIOL "KRN",19,12740,10,2,0) 12739 "KRN",19,12740,10,2,"^") PRC 1358 MISSING FIELDS "KRN",19,12740,99) 61488,58286 "KRN",19,12740,"U") COMPLIANCE REPORTS (1358) "KRN",19,12741,-1) 0^8 "KRN",19,12741,0) PRCHLO CLRS VALIDATION^CLRS Extract Validation Templates^^M^^^^^^^^IFCAP "KRN",19,12741,1,0) ^19.06^3^3^3090511^^^^ "KRN",19,12741,1,1,0) This menu contains inquiry options that can be used to validate data "KRN",19,12741,1,2,0) in the CLRS procurement extract host files by comparing data in those files "KRN",19,12741,1,3,0) to what is in VistA. "KRN",19,12741,10,0) ^19.01IP^23^23 "KRN",19,12741,10,1,0) 12745^^4 "KRN",19,12741,10,1,"^") PRCHLO PO DISCOUNT DATA "KRN",19,12741,10,2,0) 12742^^1 "KRN",19,12741,10,2,"^") PRCHLO PO MASTER DATA "KRN",19,12741,10,3,0) 12744^^3 "KRN",19,12741,10,3,"^") PRCHLO PO METHOD OF PURCHASE "KRN",19,12741,10,4,0) 12743^^2 "KRN",19,12741,10,4,"^") PRCHLO PO OBLIGATION DATA "KRN",19,12741,10,5,0) 12746^^5 "KRN",19,12741,10,5,"^") PRCHLO PO ITEM DATA "KRN",19,12741,10,6,0) 12747^^6 "KRN",19,12741,10,6,"^") PRCHLO PO ITEM INVENTORY POINT "KRN",19,12741,10,7,0) 12748^^7 "KRN",19,12741,10,7,"^") PRCHLO PO ITEM DATE RECEIVED "KRN",19,12741,10,8,0) 12749^^8 "KRN",19,12741,10,8,"^") PRCHLO PO ITEM DESCRIPTION "KRN",19,12741,10,9,0) 12750^^9 "KRN",19,12741,10,9,"^") PRCHLO PO PARTIAL DATA "KRN",19,12741,10,10,0) 12751^^10 "KRN",19,12741,10,10,"^") PRCHLO PO 2237 DATA "KRN",19,12741,10,11,0) 12752^^11 "KRN",19,12741,10,11,"^") PRCHLO PO BOC DATA "KRN",19,12741,10,12,0) 12753^^12 "KRN",19,12741,10,12,"^") PRCHLO PO COMMENTS "KRN",19,12741,10,13,0) 12754^^13 "KRN",19,12741,10,13,"^") PRCHLO PO REMARKS "KRN",19,12741,10,14,0) 12755^^14 "KRN",19,12741,10,14,"^") PRCHLO PO PROMPT PAYMENT TERMS "KRN",19,12741,10,15,0) 12756^^15 "KRN",19,12741,10,15,"^") PRCHLO PO AMOUNT "KRN",19,12741,10,16,0) 12757^^16 "KRN",19,12741,10,16,"^") PRCHLO PO AMENDMENT "KRN",19,12741,10,17,0) 12758^^17 "KRN",19,12741,10,17,"^") PRCHLO PO CHANGES AMENDMENT "KRN",19,12741,10,18,0) 12759^^18 "KRN",19,12741,10,18,"^") PRCHLO AMENDMENT DESCRIPTION "KRN",19,12741,10,19,0) 12760^^19 "KRN",19,12741,10,19,"^") PRCHLO PO AMOUNT BREAKOUT CODE "KRN",19,12741,10,20,0) 12761^^20 "KRN",19,12741,10,20,"^") PRCHLO CONTROL POINT ACTIVIT "KRN",19,12741,10,21,0) 12762^^21 "KRN",19,12741,10,21,"^") PRCHLO SUBCONTROL POINT "KRN",19,12741,10,22,0) 12763^^22 "KRN",19,12741,10,22,"^") PRCHLO 1358 DAILY RECORD "KRN",19,12741,10,23,0) 12764^^23 "KRN",19,12741,10,23,"^") PRCHLO 1358 AUTHORIZATION DET "KRN",19,12741,99) 61492,59837 "KRN",19,12741,"U") CLRS EXTRACT VALIDATION TEMPLA "KRN",19,12742,-1) 0^25 "KRN",19,12742,0) PRCHLO PO MASTER DATA^Master Data PO - F1^^I^^^^^^^^IFCAP "KRN",19,12742,1,0) ^^3^3^3090506^ "KRN",19,12742,1,1,0) This option invokes an inquiry of the Procurement & Accounting "KRN",19,12742,1,2,0) Transactions file (#442) to show data of selected fields in the "KRN",19,12742,1,3,0) file header level. "KRN",19,12742,30) PRC(442, "KRN",19,12742,31) AEMQ "KRN",19,12742,63) [PRCHLO442_HDR_VALIDATE] "KRN",19,12742,80) PRC(442, "KRN",19,12742,"U") MASTER DATA PO - F1 "KRN",19,12743,-1) 0^27 "KRN",19,12743,0) PRCHLO PO OBLIGATION DATA^Obligation Data PO - F2^^I^^^^^^^^IFCAP "KRN",19,12743,1,0) ^19.06^3^3^3090514^^^ "KRN",19,12743,1,1,0) This option invokes an inquiry of the Procurement & Accounting "KRN",19,12743,1,2,0) Transactions file (#442) to show data of selected fields in the "KRN",19,12743,1,3,0) file's Obligation Data multiple. "KRN",19,12743,30) PRC(442, "KRN",19,12743,31) AEMQ "KRN",19,12743,63) [PRCHLO442_OBLIG_VALIDATE] "KRN",19,12743,80) PRC(442, "KRN",19,12743,"U") OBLIGATION DATA PO - F2 "KRN",19,12744,-1) 0^26 "KRN",19,12744,0) PRCHLO PO METHOD OF PURCHASE^Method of Purchase PO - F3^^I^^^^^^^^IFCAP "KRN",19,12744,1,0) ^19.06^3^3^3090514^^ "KRN",19,12744,1,1,0) This option invokes an inquiry of the Procurement & Accounting "KRN",19,12744,1,2,0) Transactions file (#442) to show data of selected fields in the "KRN",19,12744,1,3,0) Purchase Method multiple. "KRN",19,12744,30) PRC(442, "KRN",19,12744,31) AEMQ "KRN",19,12744,63) [PRCHLO442_PURCH_METH_VALIDATE] "KRN",19,12744,80) PRC(442, "KRN",19,12744,"U") METHOD OF PURCHASE PO - F3 "KRN",19,12745,-1) 0^20 "KRN",19,12745,0) PRCHLO PO DISCOUNT DATA^Discount Data PO - F4^^I^^^^^^^^IFCAP "KRN",19,12745,1,0) ^^3^3^3090506^ "KRN",19,12745,1,1,0) This option invokes an inquiry of the Procurement & Accounting "KRN",19,12745,1,2,0) Transactions file (#442) to show data of selected fields in the "KRN",19,12745,1,3,0) Discount multiple. "KRN",19,12745,30) PRC(442, "KRN",19,12745,31) AEMQ "KRN",19,12745,63) [PRCHLO442_DISCOUNT_VALIDATE] "KRN",19,12745,80) PRC(442, "KRN",19,12745,"U") DISCOUNT DATA PO - F4 "KRN",19,12746,-1) 0^21 "KRN",19,12746,0) PRCHLO PO ITEM DATA^Line Item Detail PO - F5^^I^^^^^^^^IFCAP "KRN",19,12746,1,0) ^19.06^3^3^3090511^^ "KRN",19,12746,1,1,0) This option invokes any inquiry of the Procurement & Accounting "KRN",19,12746,1,2,0) Transactions file (#442) to show data of selected fields in the "KRN",19,12746,1,3,0) Line Item multiple. "KRN",19,12746,30) PRC(442, "KRN",19,12746,31) AEMQ "KRN",19,12746,63) [PRCHLO442_LINEITEM_VALIDATE] "KRN",19,12746,80) PRC(442, "KRN",19,12746,"U") LINE ITEM DETAIL PO - F5 "KRN",19,12747,-1) 0^24 "KRN",19,12747,0) PRCHLO PO ITEM INVENTORY POINT^Inventory Line Item Data PO - F6^^I^^^^^^^^IFCAP "KRN",19,12747,1,0) ^19.06^3^3^3090514^^ "KRN",19,12747,1,1,0) This option invokes an inquiry of the Procurement & Accounting "KRN",19,12747,1,2,0) Transactions file (#442) to show data of selected fields in the "KRN",19,12747,1,3,0) line item's inventory multiple. "KRN",19,12747,30) PRC(442, "KRN",19,12747,31) AEMQ "KRN",19,12747,63) [PRCHLO442_ITEM_INVPT_VALIDATE] "KRN",19,12747,80) PRC(442, "KRN",19,12747,"U") INVENTORY LINE ITEM DATA PO - "KRN",19,12748,-1) 0^22 "KRN",19,12748,0) PRCHLO PO ITEM DATE RECEIVED^Receiving of Item on PO - F7^^I^^^^^^^^IFCAP "KRN",19,12748,1,0) ^19.06^3^3^3090514^^ "KRN",19,12748,1,1,0) This option invokes an inquiry of the Procurement & Accounting "KRN",19,12748,1,2,0) Transactions file (#442) to show data of selected fields in Item's "KRN",19,12748,1,3,0) Date Received multiple. "KRN",19,12748,30) PRC(442, "KRN",19,12748,31) AEMQ "KRN",19,12748,63) [PRCHLO442_ITEM_RECV_VALIDATE] "KRN",19,12748,80) PRC(442, "KRN",19,12748,"U") RECEIVING OF ITEM ON PO - F7 "KRN",19,12749,-1) 0^23 "KRN",19,12749,0) PRCHLO PO ITEM DESCRIPTION^Item Description PO - F8^^I^^^^^^^^IFCAP "KRN",19,12749,1,0) ^^3^3^3090511^ "KRN",19,12749,1,1,0) This option invokes an inquiry of the Procurement & Accounting "KRN",19,12749,1,2,0) Transactions file (#442) to show the initial portion of the line "KRN",19,12749,1,3,0) item's description. "KRN",19,12749,30) PRC(442, "KRN",19,12749,31) AEMQ "KRN",19,12749,63) [PRCHLO442_ITEM_DESC1ST_VALID] "KRN",19,12749,80) PRC(442, "KRN",19,12749,"U") ITEM DESCRIPTION PO - F8 "KRN",19,12750,-1) 0^28 "KRN",19,12750,0) PRCHLO PO PARTIAL DATA^Partial Data PO - F9^^I^^^^^^^^IFCAP "KRN",19,12750,1,0) ^^3^3^3090511^ "KRN",19,12750,1,1,0) This option invokes an inquiry of the Procurement & Accounting "KRN",19,12750,1,2,0) Transactions file (#442) to show data of selected fields in the "KRN",19,12750,1,3,0) Partial multiple. "KRN",19,12750,30) PRC(442, "KRN",19,12750,31) AEMQ "KRN",19,12750,63) [PRCHLO442_PARTIAL_VALIDATE] "KRN",19,12750,80) PRC(442, "KRN",19,12750,"U") PARTIAL DATA PO - F9 "KRN",19,12751,-1) 0^13 "KRN",19,12751,0) PRCHLO PO 2237 DATA^Data 2237 Multiple of PO - F10^^I^^^^^^^^IFCAP "KRN",19,12751,1,0) ^^3^3^3090511^ "KRN",19,12751,1,1,0) This option invokes an inquiry of the Procurement & Accounting "KRN",19,12751,1,2,0) Transactions file (#442) to show data from selected fields of "KRN",19,12751,1,3,0) the 2237 Reference Number multiple. "KRN",19,12751,30) PRC(442, "KRN",19,12751,31) AEMQ "KRN",19,12751,63) [PRCHLO442_2237_VALIDATE] "KRN",19,12751,80) PRC(442, "KRN",19,12751,"U") DATA 2237 MULTIPLE OF PO - F10 "KRN",19,12752,-1) 0^17 "KRN",19,12752,0) PRCHLO PO BOC DATA^BOC DATA PO - F11^^I^^^^^^^^IFCAP "KRN",19,12752,1,0) ^^2^2^3090511^ "KRN",19,12752,1,1,0) This option invokes an inquiry of the Procurement & Accounting "KRN",19,12752,1,2,0) Transactions file (#442) to show data of fields in the BOC multiple. "KRN",19,12752,30) PRC(442, "KRN",19,12752,31) AEMQ "KRN",19,12752,63) [PRCHLO442_BOC_VALIDATE] "KRN",19,12752,80) PRC(442, "KRN",19,12752,"U") BOC DATA PO - F11 "KRN",19,12753,-1) 0^19 "KRN",19,12753,0) PRCHLO PO COMMENTS^Comments PO first line - F12^^I^^^^^^^^IFCAP "KRN",19,12753,1,0) ^^3^3^3090511^ "KRN",19,12753,1,1,0) This option invokes an inquiry of the Procurement & Accounting "KRN",19,12753,1,2,0) Transactions file (#442) to show the initial portion of the comments "KRN",19,12753,1,3,0) field. "KRN",19,12753,30) PRC(442, "KRN",19,12753,31) AEMQ "KRN",19,12753,63) [PRCHLO442_COMMENTS1ST_VALIDATE] "KRN",19,12753,80) PRC(442, "KRN",19,12753,"U") COMMENTS PO FIRST LINE - F12 "KRN",19,12754,-1) 0^30 "KRN",19,12754,0) PRCHLO PO REMARKS^Remarks PO first line - F13^^I^^^^^^^^IFCAP "KRN",19,12754,1,0) ^^3^3^3090511^ "KRN",19,12754,1,1,0) This option invokes an inquiry of the Procurement & Accounting "KRN",19,12754,1,2,0) Transactions file (#442) to show the initial portion of the Remarks "KRN",19,12754,1,3,0) field. "KRN",19,12754,30) PRC(442, "KRN",19,12754,31) AEMQ "KRN",19,12754,63) [PRCHLO442_REMARKS_1ST_VALIDATE] "KRN",19,12754,80) PRC(442, "KRN",19,12754,"U") REMARKS PO FIRST LINE - F13 "KRN",19,12755,-1) 0^29 "KRN",19,12755,0) PRCHLO PO PROMPT PAYMENT TERMS^Prompt Payment Terms PO - F14^^I^^^^^^^^IFCAP "KRN",19,12755,1,0) ^^3^3^3090511^ "KRN",19,12755,1,1,0) This option invokes an inquiry of the Procurement & Accounting "KRN",19,12755,1,2,0) Transactions file (#442) to show data of selected fields in the "KRN",19,12755,1,3,0) Prompt Payment Terms multiple. "KRN",19,12755,30) PRC(442, "KRN",19,12755,31) AEMQ "KRN",19,12755,63) [PRCHLO442_PROMPT_PAY_VALIDATE] "KRN",19,12755,80) PRC(442, "KRN",19,12755,"U") PROMPT PAYMENT TERMS PO - F14 "KRN",19,12756,-1) 0^15 "KRN",19,12756,0) PRCHLO PO AMOUNT^Amount PO - F15^^I^^^^^^^^IFCAP "KRN",19,12756,1,0) ^^3^3^3090511^ "KRN",19,12756,1,1,0) This option invokes an inquiry of the Procurement & Accounting "KRN",19,12756,1,2,0) Transactions file (#442) to show data of selected fields of the "KRN",19,12756,1,3,0) Amount multiple. "KRN",19,12756,30) PRC(442, "KRN",19,12756,31) AEMQ "KRN",19,12756,63) [PRCHLO442_PO_AMT_VALIDATE] "KRN",19,12756,80) PRC(442, "KRN",19,12756,"U") AMOUNT PO - F15 "KRN",19,12757,-1) 0^14 "KRN",19,12757,0) PRCHLO PO AMENDMENT^Amendment Data PO - F16^^I^^^^^^^^IFCAP "KRN",19,12757,1,0) ^^3^3^3090511^ "KRN",19,12757,1,1,0) This option invokes an inquiry of the Procurement & Accounting "KRN",19,12757,1,2,0) Transactions file (#442) to show the signatures, dollar change and "KRN",19,12757,1,3,0) other header level data of the Amendment multiple. "KRN",19,12757,30) PRC(442, "KRN",19,12757,31) AEMQ "KRN",19,12757,63) [PRCHLO442_AMENDMENT_VALIDATE] "KRN",19,12757,80) PRC(442, "KRN",19,12757,"U") AMENDMENT DATA PO - F16 "KRN",19,12758,-1) 0^18 "KRN",19,12758,0) PRCHLO PO CHANGES AMENDMENT^Changes PO Amendment - F17^^I^^^^^^^^IFCAP "KRN",19,12758,1,0) ^^3^3^3090511^ "KRN",19,12758,1,1,0) This option invokes an inquiry of the Procurement & Accounting "KRN",19,12758,1,2,0) Transactions file (#442) to show data of selected fields of the "KRN",19,12758,1,3,0) Amendment Changes multiple. "KRN",19,12758,30) PRC(442, "KRN",19,12758,31) AEMQ "KRN",19,12758,63) [PRCHLO442_AMEND_CHG_VALIDATE] "KRN",19,12758,80) PRC(442, "KRN",19,12758,"U") CHANGES PO AMENDMENT - F17 "KRN",19,12759,-1) 0^11 "KRN",19,12759,0) PRCHLO AMENDMENT DESCRIPTION^Description of PO Amendment - F18^^I^^^^^^^^IFCAP "KRN",19,12759,1,0) ^^3^3^3090511^ "KRN",19,12759,1,1,0) This option invokes an inquiry of the Procurement & Accounting "KRN",19,12759,1,2,0) Transactions file (#442) to display the initial portion of the "KRN",19,12759,1,3,0) Amendment Description. "KRN",19,12759,30) PRC(442, "KRN",19,12759,31) AEMQ "KRN",19,12759,63) [PRCHLO442_AMEND_DESCR1ST_VALID] "KRN",19,12759,80) PRC(442, "KRN",19,12759,"U") DESCRIPTION OF PO AMENDMENT - "KRN",19,12760,-1) 0^16 "KRN",19,12760,0) PRCHLO PO AMOUNT BREAKOUT CODE^Breakout Code PO - F19^^I^^^^^^^^IFCAP "KRN",19,12760,1,0) ^19.06^3^3^3090514^^ "KRN",19,12760,1,1,0) This option invokes an inquiry of the Procurement & Accounting "KRN",19,12760,1,2,0) Transactions file (#442) to show data of selected fields of the "KRN",19,12760,1,3,0) Breakout Code multiple of the Amount multiple. "KRN",19,12760,30) PRC(442, "KRN",19,12760,31) AEMQ "KRN",19,12760,63) [PRCHLO442_BREAKOUT_C_VALIDATE] "KRN",19,12760,80) PRC(442, "KRN",19,12760,"U") BREAKOUT CODE PO - F19 "KRN",19,12761,-1) 0^12 "KRN",19,12761,0) PRCHLO CONTROL POINT ACTIVIT^Control Point Activities - F20^^I^^^^^^^^IFCAP "KRN",19,12761,1,0) ^^3^3^3090511^ "KRN",19,12761,1,1,0) This option invokes an inquiry of the Control Point Activities "KRN",19,12761,1,2,0) file (#410) to show data of selected fields at the file header "KRN",19,12761,1,3,0) level. "KRN",19,12761,30) PRCS(410, "KRN",19,12761,31) AEMQ "KRN",19,12761,63) [PRCHLO410_HDR_VALIDATE] "KRN",19,12761,80) PRCS(410, "KRN",19,12761,"U") CONTROL POINT ACTIVITIES - F20 "KRN",19,12762,-1) 0^31 "KRN",19,12762,0) PRCHLO SUBCONTROL POINT^Subcontrol Point Activity - F21^^I^^^^^^^^IFCAP "KRN",19,12762,1,0) ^^3^3^3090511^ "KRN",19,12762,1,1,0) This option invokes an inquiry of the Control Point Activity "KRN",19,12762,1,2,0) file (#410) to show data of selected fields of the Sub-Control "KRN",19,12762,1,3,0) Point multiple. "KRN",19,12762,30) PRCS(410, "KRN",19,12762,31) AEMQ "KRN",19,12762,63) [PRCHLO410-04_VALIDATE] "KRN",19,12762,80) PRCS(410, "KRN",19,12762,"U") SUBCONTROL POINT ACTIVITY - F2 "KRN",19,12763,-1) 0^10 "KRN",19,12763,0) PRCHLO 1358 DAILY RECORD^Daily Record 1358 - F22^^I^^^^^^^^IFCAP "KRN",19,12763,1,0) ^^2^2^3090511^ "KRN",19,12763,1,1,0) This option invokes an inquiry of the 1358 Daily Record file (#424) "KRN",19,12763,1,2,0) to show data of selected fields. "KRN",19,12763,30) PRC(424, "KRN",19,12763,31) AEMQ "KRN",19,12763,63) [PRCHLO424_VALIDATE] "KRN",19,12763,80) PRC(424, "KRN",19,12763,"U") DAILY RECORD 1358 - F22 "KRN",19,12764,-1) 0^9 "KRN",19,12764,0) PRCHLO 1358 AUTHORIZATION DET^Authorization Detail 1358 - F23^^I^^^^^^^^IFCAP "KRN",19,12764,1,0) ^^2^2^3090511^ "KRN",19,12764,1,1,0) This option invokes an inquiry of the 1358 Authorization Detail "KRN",19,12764,1,2,0) file (#424.1) to show data of selected fields. "KRN",19,12764,30) PRC(424.1, "KRN",19,12764,31) AEMQ "KRN",19,12764,63) [PRCHLO424-1_VALIDATE] "KRN",19,12764,80) PRC(424.1, "KRN",19,12764,"U") AUTHORIZATION DETAIL 1358 - F2 "KRN",8989.51,4817,-1) 0^3 "KRN",8989.51,4817,0) PRCPLO USER NAME^PRCPLO USER NAME^0 "KRN",8989.51,4817,1) F^$L(X)<35^Enter user name for CLRS report server login "KRN",8989.51,4817,4,0) ^8989.514^1^1 "KRN",8989.51,4817,4,1,0) PRC "KRN",8989.51,4817,4,"B","PRC",1) "KRN",8989.51,4817,20,0) ^8989.512^2^2^3090304^^^ "KRN",8989.51,4817,20,1,0) This parameter will store the user login name for the Clinical Logistics "KRN",8989.51,4817,20,2,0) Report Server. "KRN",8989.51,4818,-1) 0^1 "KRN",8989.51,4818,0) PRCPLO PASSWORD^PRCPLO PASSWORD^0^^^0 "KRN",8989.51,4818,1) F^$L(X)<35^Enter password for CLRS report server login "KRN",8989.51,4818,4,0) ^8989.514^2^1 "KRN",8989.51,4818,4,2,0) PRCPLO "KRN",8989.51,4818,4,"B","PRCPLO",2) "KRN",8989.51,4818,20,0) ^8989.512^2^2^3090304^^^ "KRN",8989.51,4818,20,1,0) This parameter will store the user login password for the Clinical "KRN",8989.51,4818,20,2,0) Logistics Report Server. "KRN",8989.51,4819,-1) 0^2 "KRN",8989.51,4819,0) PRCPLO REGIONAL ACQ CENTER^PRCPLO REGIONAL ACQ CENTER^0^^^0 "KRN",8989.51,4819,1) F^$L(X)<35^Please enter Regional Acquisition Center to group Purchase Order transactions "KRN",8989.51,4819,4,0) ^8989.514^1^1 "KRN",8989.51,4819,4,1,0) PRC "KRN",8989.51,4819,4,"B","PRC",1) "KRN",8989.51,4819,20,0) ^8989.512^2^2^3090304^^ "KRN",8989.51,4819,20,1,0) This parameter will store the Regional Acquisition Center which will be "KRN",8989.51,4819,20,2,0) populated by the station and used to group Purchase Order transactions. "MBREQ") 0 "ORD",5,.4) .4;5;;;EDEOUT^DIFROMSO(.4,DA,"",XPDA);FPRE^DIFROMSI(.4,"",XPDA);EPRE^DIFROMSI(.4,DA,$E("N",$G(XPDNEW)),XPDA,"",OLDA);;EPOST^DIFROMSI(.4,DA,"",XPDA);DEL^DIFROMSK(.4,"",%) "ORD",5,.4,0) PRINT TEMPLATE "ORD",6,.401) .401;6;;;EDEOUT^DIFROMSO(.401,DA,"",XPDA);FPRE^DIFROMSI(.401,"",XPDA);EPRE^DIFROMSI(.401,DA,$E("N",$G(XPDNEW)),XPDA,"",OLDA);;EPOST^DIFROMSI(.401,DA,"",XPDA);DEL^DIFROMSK(.401,"",%) "ORD",6,.401,0) SORT TEMPLATE "ORD",11,3.8) 3.8;11;;;MAILG^XPDTA1;MAILGF1^XPDIA1;MAILGE1^XPDIA1;MAILGF2^XPDIA1;;MAILGDEL^XPDIA1(%) "ORD",11,3.8,0) MAIL GROUP "ORD",18,19) 19;18;;;OPT^XPDTA;OPTF1^XPDIA;OPTE1^XPDIA;OPTF2^XPDIA;;OPTDEL^XPDIA "ORD",18,19,0) OPTION "ORD",20,8989.51) 8989.51;20;;;PAR1E1^XPDTA2;PAR1F1^XPDIA3;PAR1E1^XPDIA3;PAR1F2^XPDIA3;;PAR1DEL^XPDIA3(%) "ORD",20,8989.51,0) PARAMETER DEFINITION "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) 130^3090708 "PKG",455,22,1,"PAH",1,1,0) ^^2^2^3090708 "PKG",455,22,1,"PAH",1,1,1,0) This patch introduces enhancements to facilitate monitoring of "PKG",455,22,1,"PAH",1,1,2,0) 1358 usage. "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") NO "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") 13 "RTN","PRC1358C") 0^15^B4910186^n/a "RTN","PRC1358C",1,0) PRC1358C ;WOIFO/LKG-1358 COMPLIANCE REPORTS ;5/17/09 23:37 "RTN","PRC1358C",2,0) ;;5.1;IFCAP;**130**;Oct 20, 2000;Build 25 "RTN","PRC1358C",3,0) ;Per VHA Directive 2004-038, this routine should not be modified. "RTN","PRC1358C",4,0) IN1 ;Entry point for execution of scheduled 1358 compliance reports and "RTN","PRC1358C",5,0) ;start of logic for 1358 Separation of Duties Violations report "RTN","PRC1358C",6,0) N PRCDOW S PRCDOW=$$DOW^XLFDT($$NOW^XLFDT,1) Q:PRCDOW=0 ;Quit if Sunday "RTN","PRC1358C",7,0) N L,DIOBEG,DIOEND,DIC,DISUPNO,FLDS,BY,FR,TO,IOP,XMQUIET,XMDUZ,XMSUB,XMY "RTN","PRC1358C",8,0) S L=0,DIC=410,BY="[PRC SEPARATION VIOLATE]",FLDS="[PRC 1358 SEPARATION VIOL]" "RTN","PRC1358C",9,0) ;Set FR to "T-2" for Monday's output and "T-1" for other days "RTN","PRC1358C",10,0) S FR=$S(PRCDOW=1:"T-2",1:"T-1"),TO="T-1",IOP="P-MESSAGE-HFS;79" "RTN","PRC1358C",11,0) S XMQUIET=1,XMDUZ="1358 EXAMINER",XMSUB="1358 SEPARATION OF DUTIES VIOLATIONS" "RTN","PRC1358C",12,0) S XMY("G.PRC 1358 MONITORS")="" "RTN","PRC1358C",13,0) D EN1^DIP "RTN","PRC1358C",14,0) IN2 ;Start of code for Missing Fields report "RTN","PRC1358C",15,0) K L,DIOBEG,DIOEND,DIC,DISUPNO,FLDS,BY,FR,TO,IOP,XMQUIET,XMDUZ,XMSUB,XMY "RTN","PRC1358C",16,0) S L=0,DIC=410,BY="[PRC MISSING 1358 FIELDS]",FLDS="[PRC 1358 MISSING FIELDS]" "RTN","PRC1358C",17,0) ;Set FR to "T-2" for Monday's output and "T-1" for other days "RTN","PRC1358C",18,0) S FR(3)=$S(PRCDOW=1:"T-2",1:"T-1"),TO(3)="T-1",IOP="P-MESSAGE-HFS;79" "RTN","PRC1358C",19,0) S XMQUIET=1,XMDUZ="1358 EXAMINER",XMSUB="1358 MISSING FIELDS" "RTN","PRC1358C",20,0) S XMY("G.PRC 1358 MONITORS")="" "RTN","PRC1358C",21,0) D EN1^DIP "RTN","PRC1358C",22,0) Q "RTN","PRC1358C",23,0) ; "RTN","PRC1358C",24,0) IN3 ;Entry point for user interactive 1358 Separation of Duties Violations report "RTN","PRC1358C",25,0) N L,DIOBEG,DIOEND,DIC,DIPCRIT,DISUPNO,FLDS,BY,FR,TO,IOP,X S DIPCRIT=1 "RTN","PRC1358C",26,0) S DIOBEG="W:$E(IOST,1,2)=""C-"" @IOF",DIOEND="R:$E(IOST,1,2)=""C-"" !,""Press RETURN to continue..."",X:DTIME" "RTN","PRC1358C",27,0) S L=0,DIC=410,BY="[PRC SEPARATION VIOLATE]",FLDS="[PRC 1358 SEPARATION VIOL]" "RTN","PRC1358C",28,0) D EN1^DIP "RTN","PRC1358C",29,0) Q "RTN","PRC1358C",30,0) ; "RTN","PRC1358C",31,0) IN4 ;Entry point for user interactive Missing 1358 Fields report "RTN","PRC1358C",32,0) N L,DIOBEG,DIOEND,DIC,DIPCRIT,DISUPNO,FLDS,BY,FR,TO,IOP S DIPCRIT=1 "RTN","PRC1358C",33,0) S DIOBEG="W:$E(IOST,1,2)=""C-"" @IOF",DIOEND="R:$E(IOST,1,2)=""C-"" !,""Press RETURN to continue..."",X:DTIME" "RTN","PRC1358C",34,0) S L=0,DIC=410,BY="[PRC MISSING 1358 FIELDS]",FLDS="[PRC 1358 MISSING FIELDS]" "RTN","PRC1358C",35,0) D EN1^DIP "RTN","PRC1358C",36,0) Q "RTN","PRCFFU2") 0^1^B8191248^B7796653 "RTN","PRCFFU2",1,0) PRCFFU2 ;WISC/SJG-FMS MO2 SEGMENT ;5/17/09 23:38 "RTN","PRCFFU2",2,0) ;;5.1;IFCAP;**130**;Oct 20, 2000;Build 25 "RTN","PRCFFU2",3,0) ;Per VHA Directive 2004-038, this routine should not be modified. "RTN","PRCFFU2",4,0) ; "RTN","PRCFFU2",5,0) MO2(NODE,TYCODE) ;BUILD 'MO2' SEGMENT "RTN","PRCFFU2",6,0) ; .1 - P.O. DATE FROM 442 .01 - NAME FROM 440 "RTN","PRCFFU2",7,0) ; 5 - VENDOR FROM 442 .06 - FEDERAL SOURCE FROM 440 "RTN","PRCFFU2",8,0) ; 6.4 - FOB POINT FROM 442 34 - FMS VENDOR CODE FROM 440 "RTN","PRCFFU2",9,0) ; 35 - ALT-ADDR-IND FROM 440 "RTN","PRCFFU2",10,0) MO2A N SEG,FMSYR,FMSMO,FMSDAY,VEND,FMSVENCD,FMSVENNM,FMSPODAT,FMSFOB "RTN","PRCFFU2",11,0) S (FMSVENID,FMSVENCD,FMSVENNM,FMSFOB)="" "RTN","PRCFFU2",12,0) S TMPLINE=TMPLINE+1 "RTN","PRCFFU2",13,0) K PRCTMP N DA S DIC=442,DR=".1;5;6.4",DA=+PO,DIQ="PRCTMP(",DIQ(0)="IE" D EN^DIQ1 K DIC,DIQ,DR "RTN","PRCFFU2",14,0) MO2B I (TRCODE="MO")&(("^1^3^4^7^8^26^"[("^"_PRCFA("MP")_"^"))) D "RTN","PRCFFU2",15,0) .S (BEGDATE,FMSPODAT,PODATE)=PRCFA("OBLDATE") "RTN","PRCFFU2",16,0) .D DATE(FMSPODAT,.A,.B,.C) S FMSPODAT=FMSYR_U_FMSMO_U_FMSDAY "RTN","PRCFFU2",17,0) MO2C I (TRCODE="SO")&(PRCFA("MP")=2) D "RTN","PRCFFU2",18,0) .S (BEGDATE,FMSPODAT,PODATE)=PRCFA("OBLDATE") "RTN","PRCFFU2",19,0) .D DATE(FMSPODAT,.A,.B,.C) S FMSPODAT=FMSYR_U_FMSMO_U_FMSDAY "RTN","PRCFFU2",20,0) MO2D I (TRCODE="SO")&(PRCFA("MP")=21) D "RTN","PRCFFU2",21,0) .I TYCODE="E" D "RTN","PRCFFU2",22,0) ..S (BEGDATE,FMSPODAT,PODATE)=PRCFA("OBLDATE") "RTN","PRCFFU2",23,0) ..S FMSPODAT=$E(PODATE,2,3)_U_$E(PODATE,4,5)_U_$E(PODATE,6,7) "RTN","PRCFFU2",24,0) ..Q "RTN","PRCFFU2",25,0) .I TYCODE="M" D "RTN","PRCFFU2",26,0) ..S (BEGDATE,FMSPODAT,PODATE)=PRCFA("OBLDATE") "RTN","PRCFFU2",27,0) ..D DATE(FMSPODAT,.A,.B,.C) S FMSPODAT=FMSYR_U_FMSMO_U_FMSDAY "RTN","PRCFFU2",28,0) ..Q "RTN","PRCFFU2",29,0) MO2E D "RTN","PRCFFU2",30,0) .I TYCODE="M" Q:'PRCFA("FOB") "RTN","PRCFFU2",31,0) .S (FMSFOB,FOB)=$G(PRCTMP(442,+PO,6.4,"I")) "RTN","PRCFFU2",32,0) .I FOB="" S (FMSFOB,FOB)="D" "RTN","PRCFFU2",33,0) MO2F D "RTN","PRCFFU2",34,0) .I TYCODE="M" Q:'PRCFA("VEND") "RTN","PRCFFU2",35,0) .S VEND=$G(PRCTMP(442,+PO,5,"I")) "RTN","PRCFFU2",36,0) .I VEND]"" D "RTN","PRCFFU2",37,0) ..N DA S DIC=440,DR=".01;.06;34;35",DA=+VEND,DIQ="PRCTMP(",DIQ(0)="IE" D EN^DIQ1 K DIC,DIQ,DR "RTN","PRCFFU2",38,0) ..S FMSVENID=$G(PRCTMP(440,VEND,34,"E")) "RTN","PRCFFU2",39,0) ..S FMSVENCD=$G(PRCTMP(440,VEND,35,"E")) "RTN","PRCFFU2",40,0) ..S FMSVENNM=$G(PRCTMP(440,VEND,.01,"E")) "RTN","PRCFFU2",41,0) ..S FMSVENNM=$E(FMSVENNM,1,30) "RTN","PRCFFU2",42,0) ..I FMSVENID="" D "RTN","PRCFFU2",43,0) ...S FMSFED=$G(PRCTMP(440,VEND,.06,"I")) "RTN","PRCFFU2",44,0) ...S FMSVENID=$S(FMSFED:"MISCG",'FMSFED:"MISCN") "RTN","PRCFFU2",45,0) .I VEND="" I TRCODE="SO" S FMSVENID="MISCN",(FMSVENCD,FMSVENNM)="" "RTN","PRCFFU2",46,0) MO2G S SEG="MO2^"_FMSPODAT "RTN","PRCFFU2",47,0) N ACCMO,ACCYR,ACCPD "RTN","PRCFFU2",48,0) S ACCPD=$P($G(PRCFA("ACCPD")),U),ACCMO=$E(ACCPD,1,2),ACCYR=$E(ACCPD,3,4) "RTN","PRCFFU2",49,0) S $P(SEG,U,5)=ACCMO,$P(SEG,U,6)=ACCYR,$P(SEG,U,10)=TYCODE "RTN","PRCFFU2",50,0) I TRCODE="SO" S $P(SEG,U,11)=$S(PRCFA("MP")=2:"C",PRCFA("MP")=21:"T",1:"") "RTN","PRCFFU2",51,0) I FMSVENID]"" S $P(SEG,U,14)=FMSVENID "RTN","PRCFFU2",52,0) I FMSVENCD]"" S $P(SEG,U,15)=FMSVENCD "RTN","PRCFFU2",53,0) I (FMSVENID="MISCN")!(FMSVENID="MISCG") I FMSVENNM]"" S $P(SEG,U,16)=FMSVENNM "RTN","PRCFFU2",54,0) I FMSFOB]"" S $P(SEG,U,24)=FMSFOB "RTN","PRCFFU2",55,0) S ^TMP($J,"PRCMO",INT,TMPLINE)=SEG_"^~" K PRCTMP "RTN","PRCFFU2",56,0) Q "RTN","PRCFFU2",57,0) ; "RTN","PRCFFU2",58,0) DATE(X,A,B,C) ; "RTN","PRCFFU2",59,0) S FMSYR=$E(X,2,3),FMSMO=$E(X,4,5),FMSDAY=$E(X,6,7) "RTN","PRCFFU2",60,0) Q "RTN","PRCFFU2",61,0) DATE1(X) ; "RTN","PRCFFU2",62,0) Q $E(X,4,5)_$E(X,6,7)_$E(X,2,3) "RTN","PRCFFU2",63,0) Q "RTN","PRCFFU2",64,0) ASKDATE(X) ; "RTN","PRCFFU2",65,0) N Y,ASKDATE "RTN","PRCFFU2",66,0) S %DT="AEX",%DT("A")=X D ^%DT "RTN","PRCFFU2",67,0) S ASKDATE=Y K %DT "RTN","PRCFFU2",68,0) Q ASKDATE "RTN","PRCFFU8") 0^2^B12574203^B11990139 "RTN","PRCFFU8",1,0) PRCFFU8 ;WISC/SJG-OBLIGATION PROCESSING UTILITIES, CON'T ;5/17/09 23:39 "RTN","PRCFFU8",2,0) ;;5.1;IFCAP;**130**;Oct 20, 2000;Build 25 "RTN","PRCFFU8",3,0) ;Per VHA Directive 2004-038, this routine should not be modified. "RTN","PRCFFU8",4,0) ; "RTN","PRCFFU8",5,0) ; No Top Level Entry "RTN","PRCFFU8",6,0) QUIT "RTN","PRCFFU8",7,0) MSG ; "RTN","PRCFFU8",8,0) W !!,"This Purchase Order Amendment will not require a Modification " "RTN","PRCFFU8",9,0) W:PRCFA("TT")="MO" !,"Miscellaneous Order (MO) " "RTN","PRCFFU8",10,0) W:PRCFA("TT")="SO" !,"Service Order (SO) " "RTN","PRCFFU8",11,0) W "Document for the following reason(s):" "RTN","PRCFFU8",12,0) W !!,"The Amendment consisted of: " "RTN","PRCFFU8",13,0) I $D(PRCFA("SHIP")),PRCFA("SHIP")]"" W ?30,PRCFA("SHIP"),! "RTN","PRCFFU8",14,0) I $D(PRCFA("SOURCE")),PRCFA("SOURCE")]"" W ?30,PRCFA("SOURCE"),! "RTN","PRCFFU8",15,0) I $D(PRCFA("MAIL")),PRCFA("MAIL")]"" W ?30,PRCFA("MAIL"),! "RTN","PRCFFU8",16,0) I $D(PRCFA("ADMADD")),PRCFA("ADMADD")]"" W ?30,PRCFA("ADMADD"),! "RTN","PRCFFU8",17,0) I $D(PRCFA("ADMDEL")),PRCFA("ADMDEL")]"" W ?30,PRCFA("ADMDEL"),! "RTN","PRCFFU8",18,0) I $D(PRCFA("AUTH")),PRCFA("AUTH")]"" W ?30,PRCFA("AUTH"),! "RTN","PRCFFU8",19,0) I $D(PRCFA("ZERO")),PRCFA("ZERO")]"" W ?30,PRCFA("ZERO"),! H 3 "RTN","PRCFFU8",20,0) I $D(PRCFA("WASH")),PRCFA("WASH")]"" W ?30,PRCFA("WASH"),! H 3 "RTN","PRCFFU8",21,0) W !!,"No Modification FMS Document has been transmitted!!" H 3 "RTN","PRCFFU8",22,0) QUIT "RTN","PRCFFU8",23,0) ; "RTN","PRCFFU8",24,0) CANCEL(REF,TYPE) ; Cancel FMS Obligation Documents "RTN","PRCFFU8",25,0) ; REF - PAT Reference Number "RTN","PRCFFU8",26,0) ; TYPE - FMS Transaction Type "RTN","PRCFFU8",27,0) ; DATA - MO2 Segment "RTN","PRCFFU8",28,0) N DATA "RTN","PRCFFU8",29,0) S (PRCFA("MOD"),PRCFA("CANCEL"))="X^2^Cancellation Entry" "RTN","PRCFFU8",30,0) S FMSMOD=$P(PRCFA("MOD"),U) "RTN","PRCFFU8",31,0) I PRCFA("TT")="AR",$E(REF,11,12)'=12 S REF=$E(REF,1,10)_12 "RTN","PRCFFU8",32,0) S FMSSEC=$$SEC1^PRC0C(PRC("SITE")) "RTN","PRCFFU8",33,0) I TYPE="AR" D CANC S TYPE="SO",REF=$E(REF,1,10) "RTN","PRCFFU8",34,0) D:$G(MTOPDA)="" DEC,CANC Q "RTN","PRCFFU8",35,0) DEC ; "RTN","PRCFFU8",36,0) Q:XRBLD=2 ; exit if rebuilding the 'E' (amended original) transaction "RTN","PRCFFU8",37,0) W !!,"...now generating the FMS Decrease "_TYPE_" Obligation Document..." "RTN","PRCFFU8",38,0) S FMSDES="Decrease Obligation Amount of "_TYPE_" Obligation Document" "RTN","PRCFFU8",39,0) I XRBLD=0 D CONTROL^GECSUFMS("I",PRC("SITE"),REF,TYPE,FMSSEC,1,"Y",FMSDES) "RTN","PRCFFU8",40,0) S DATA=$$SEG2^PRCFFU8("X^"_TYPE,POIEN,.SEG) "RTN","PRCFFU8",41,0) D GECS "RTN","PRCFFU8",42,0) S PRCFA("PODA")=PRCFA("OLDPODA") "RTN","PRCFFU8",43,0) I '$D(POESIG) I $D(PRCFA("PODA")),+PRCFA("PODA")>0 S POESIG=1 "RTN","PRCFFU8",44,0) N FMSDOCT S FMSDOCT=$P(PRCFA("REF"),"-",2) "RTN","PRCFFU8",45,0) D EN7^PRCFFU41(TYPE,FMSMOD,PRCFA("OBLDATE"),FMSDOCT) "RTN","PRCFFU8",46,0) Q "RTN","PRCFFU8",47,0) CANC ; "RTN","PRCFFU8",48,0) Q:XRBLD=2 "RTN","PRCFFU8",49,0) W !!,"...now generating the FMS "_TYPE_" Cancellation Document..." "RTN","PRCFFU8",50,0) S FMSDES="Cancellation of "_TYPE_" Obligation Document" "RTN","PRCFFU8",51,0) I XRBLD=0 D CONTROL^GECSUFMS("I",PRC("SITE"),REF,TYPE,FMSSEC,1,"Y",FMSDES) "RTN","PRCFFU8",52,0) S DATA=$$SEG2^PRCFFU8("X^"_TYPE,POIEN,.SEG) "RTN","PRCFFU8",53,0) D GECS "RTN","PRCFFU8",54,0) S PRCFA("PODA")=PRCFA("OLDPODA") "RTN","PRCFFU8",55,0) I '$D(POESIG) I $D(PRCFA("PODA")),+PRCFA("PODA")>0 S POESIG=1 "RTN","PRCFFU8",56,0) N FMSDOCT S FMSDOCT=$P(PRCFA("REF"),"-",2) "RTN","PRCFFU8",57,0) D EN7^PRCFFU41(TYPE,FMSMOD,PRCFA("OBLDATE"),FMSDOCT) "RTN","PRCFFU8",58,0) Q "RTN","PRCFFU8",59,0) ; "RTN","PRCFFU8",60,0) GECS ; Common GECS processing for 'X' documents "RTN","PRCFFU8",61,0) D SETCS^GECSSTAA(GECSFMS("DA"),DATA) "RTN","PRCFFU8",62,0) D SETSTAT^GECSSTAA(GECSFMS("DA"),"Q") "RTN","PRCFFU8",63,0) N P2 S P2=+PO_"/"_PRCFA("AMEND#"),$P(P2,"/",5)=$P($G(PRCFA("ACCPD")),U),$P(P2,"/",6)=PRCFA("OBLDATE") "RTN","PRCFFU8",64,0) D SETPARAM^GECSSDCT(GECSFMS("DA"),P2) "RTN","PRCFFU8",65,0) Q "RTN","PRCFFU8",66,0) SEG2(TYPE,IEN,SEG) ; Create MO2 segment for cancellation document "RTN","PRCFFU8",67,0) ; IEN - Internal Entry Number of Purchase Order "RTN","PRCFFU8",68,0) ; TYPE - FMS Document Type "RTN","PRCFFU8",69,0) ; SEG - Return value for MO2 segment "RTN","PRCFFU8",70,0) D GENDIQ^PRCFFU7(442,IEN,.1,"I","") "RTN","PRCFFU8",71,0) S FMSPODAT=$G(PRCFA("OBLDATE")) "RTN","PRCFFU8",72,0) I FMSPODAT="" D NOW^%DTC S FMSPODAT=X "RTN","PRCFFU8",73,0) D DATE^PRCFFU2(FMSPODAT,.A,.B,.C) "RTN","PRCFFU8",74,0) S FMSPODAT=FMSYR_"^"_FMSMO_"^"_FMSDAY "RTN","PRCFFU8",75,0) I $P(TYPE,"^",2)="AR" S SEG="RC2",$P(SEG,U,7)=$P(TYPE,"^",1)_"^~" "RTN","PRCFFU8",76,0) E S SEG="MO2",$P(SEG,U,10)=$P(TYPE,"^",1)_"^~" "RTN","PRCFFU8",77,0) S $P(SEG,"^",2,4)=FMSPODAT "RTN","PRCFFU8",78,0) I $P(TYPE,"^",2)="SO",PRCFA("MP")=2 S $P(SEG,U,11)="C" "RTN","PRCFFU8",79,0) S:$P(SEG,U,$L(SEG,U))'="~" SEG=SEG_"^~" "RTN","PRCFFU8",80,0) K PRCTMP "RTN","PRCFFU8",81,0) QUIT SEG "RTN","PRCH130") 0^14^B4880900^n/a "RTN","PRCH130",1,0) PRCH130 ;WISC/AS-post init patch 130 ;5/18/09 12:27 "RTN","PRCH130",2,0) ;;5.1;IFCAP;**130**;Oct 20, 2000;Build 25 "RTN","PRCH130",3,0) ;Per VHA Directive 2004-038, this routine should not be modified. "RTN","PRCH130",4,0) ; "RTN","PRCH130",5,0) INIT ; "RTN","PRCH130",6,0) ; Populate values of password, and user name of the report production "RTN","PRCH130",7,0) ; server By envoke EN^XPAR using methods detailed in IA #2263 "RTN","PRCH130",8,0) ; "RTN","PRCH130",9,0) N PRCP1,PRCP2,PRCP3 "RTN","PRCH130",10,0) S PRCP3=0 ; Error Flag "RTN","PRCH130",11,0) I '$$PROD^XUPROD() S PRCP3=2 G EXIT ; Quit if not production "RTN","PRCH130",12,0) S PRCP1="2w5`WNj:c1" ; Encrypted password value "RTN","PRCH130",13,0) D EN^XPAR("SYS","PRCPLO PASSWORD",1,PRCP1,.PRCP2) "RTN","PRCH130",14,0) I PRCP2=0 D BMES^XPDUTL("PRCPLO PASSWORD successfully populated") "RTN","PRCH130",15,0) I PRCP2'=0 S PRCP3=1 D BMES^XPDUTL("Error while trying to populate the PRCPLO PASSWORD:") D MES^XPDUTL($P(PRCP2,"^",2)) "RTN","PRCH130",16,0) S PRCP1="/?uK!26%Yh!" ; Encrypted user name value "RTN","PRCH130",17,0) D EN^XPAR("SYS","PRCPLO USER NAME",1,PRCP1,.PRCP2) "RTN","PRCH130",18,0) I PRCP2=0 D BMES^XPDUTL("PRCPLO USER NAME successfully populated") "RTN","PRCH130",19,0) I PRCP2'=0 S PRCP3=1 D BMES^XPDUTL("Error while trying to populate the PRCPLO USER NAME:") D MES^XPDUTL($P(PRCP2,"^",2)) "RTN","PRCH130",20,0) EXIT ; "RTN","PRCH130",21,0) I PRCP3=0 D MES^XPDUTL("POST-INSTALL COMPLETED SUCCESSFULLY!") "RTN","PRCH130",22,0) I PRCP3=1 D MES^XPDUTL("POST-INSTALL COMPLETED WITH ERRORS!!!") "RTN","PRCH130",23,0) I PRCP3=2 N PRCMSG S PRCMSG(1)="As this is not a production system, username and password for the FTP Server",PRCMSG(2)=" were not filed." D MES^XPDUTL(.PRCMSG) "RTN","PRCH130",24,0) Q "RTN","PRCHLO") 0^3^B11530843^B11873921 "RTN","PRCHLO",1,0) PRCHLO ;WOIFO/RLL-EXTRACT ROUTINE CLO REPORT SERVER ;5/17/09 23:40 "RTN","PRCHLO",2,0) ;;5.1;IFCAP;**83,104,130**;Oct 20, 2000;Build 25 "RTN","PRCHLO",3,0) ; Per VHA Directive 2004-038, this routine should not be modified "RTN","PRCHLO",4,0) ; "RTN","PRCHLO",5,0) ; PRCHLO* routines are used to build the extract files from "RTN","PRCHLO",6,0) ; file 410, 424, and 442 for the clinical logistics report server. "RTN","PRCHLO",7,0) ; PRCHLO thru PRCHLO6 perform the following: "RTN","PRCHLO",8,0) ; 1. Initialize environment "RTN","PRCHLO",9,0) ; 2. Get parameters for the month being run "RTN","PRCHLO",10,0) ; 3. Pull data from file 410, 424, and 442 for month being run "RTN","PRCHLO",11,0) ; 4. Create multiple "^" delimited flat files for report server "RTN","PRCHLO",12,0) ; 5. At the completion of extracts FTP files to report server "RTN","PRCHLO",13,0) ; 6. Clean up / remove any temp files "RTN","PRCHLO",14,0) ; 7. logout "RTN","PRCHLO",15,0) ; CALC is the programmer entry point used to test the extract "RTN","PRCHLO",16,0) ; options for the first iteration of coding "RTN","PRCHLO",17,0) ; "RTN","PRCHLO",18,0) Q "RTN","PRCHLO",19,0) INIT ; Initialize environment "RTN","PRCHLO",20,0) ; "RTN","PRCHLO",21,0) K ^TMP($J) "RTN","PRCHLO",22,0) ; "RTN","PRCHLO",23,0) ; Get todays date "RTN","PRCHLO",24,0) N % "RTN","PRCHLO",25,0) S %=$P(($$NOW^XLFDT),".",1) "RTN","PRCHLO",26,0) ; (old logic) "RTN","PRCHLO",27,0) ; Always start from the 1st of the month to the end of month "RTN","PRCHLO",28,0) ; and at least 45 days prior to todays date "RTN","PRCHLO",29,0) ; "RTN","PRCHLO",30,0) ; (new logic) "RTN","PRCHLO",31,0) ; Always start from the beginning of the Fiscal Year and run "RTN","PRCHLO",32,0) ; the extract up until the Date of the extract run (NOW) "RTN","PRCHLO",33,0) ; "RTN","PRCHLO",34,0) ; The CALC entry point is used for testing from programmer mode "RTN","PRCHLO",35,0) ; and allows the programmer to pass a specific date "RTN","PRCHLO",36,0) ; in the variable %=FM date format "RTN","PRCHLO",37,0) ; "RTN","PRCHLO",38,0) CALC ;test entry point, set %I to FM date "RTN","PRCHLO",39,0) ; "RTN","PRCHLO",40,0) N CLO1,CLO2,CLO2B,CLO2E,CLO3,CLOBGN,CLOEND,CLO1A "RTN","PRCHLO",41,0) N MTHRUN,YRRUN,PYRRUN "RTN","PRCHLO",42,0) S CLO1=$E(%,1,3) "RTN","PRCHLO",43,0) ; "RTN","PRCHLO",44,0) S CLO2=$E(%,4,5) "RTN","PRCHLO",45,0) S YRRUN=+(CLO1) "RTN","PRCHLO",46,0) S PYRRUN=YRRUN-1 ; previous Year Run "RTN","PRCHLO",47,0) S MTHRUN=+(CLO2) "RTN","PRCHLO",48,0) I +CLO2>2 D "RTN","PRCHLO",49,0) . S CLO2B=CLO2-2 "RTN","PRCHLO",50,0) . I $L(CLO2B)<2 S CLO2B=0_CLO2B "RTN","PRCHLO",51,0) . S CLO2E=CLO2-1 "RTN","PRCHLO",52,0) . I $L(CLO2E)<2 S CLO2E=0_CLO2E "RTN","PRCHLO",53,0) . S CLOBGN=+(CLO1_(CLO2B)_"00") "RTN","PRCHLO",54,0) . S CLOEND=+(CLO1_(CLO2E)_"01") "RTN","PRCHLO",55,0) . Q "RTN","PRCHLO",56,0) ; "RTN","PRCHLO",57,0) ; check for January run, and Feb run "RTN","PRCHLO",58,0) I +CLO2=1 D "RTN","PRCHLO",59,0) . S CLO1=CLO1-1 "RTN","PRCHLO",60,0) . S CLOBGN=+(CLO1_11_"00") ; Start date is Nov 1st "RTN","PRCHLO",61,0) . S CLOEND=+(CLO1_12_"01") ; End date is Dec 1st "RTN","PRCHLO",62,0) . Q "RTN","PRCHLO",63,0) I +CLO2=2 D "RTN","PRCHLO",64,0) . S CLO1A=CLO1-1 ; Need to get Dec, previous year "RTN","PRCHLO",65,0) . S CLOBGN=+(CLO1A_12_"00") ; Start date is Dec 1st "RTN","PRCHLO",66,0) . S CLOEND=+(CLO1_"01"_"01") ; End date is Jan 1st "RTN","PRCHLO",67,0) . Q "RTN","PRCHLO",68,0) ; "RTN","PRCHLO",69,0) ; (Begin new logic) "RTN","PRCHLO",70,0) FYRNOW ; Changes added 07/31/06 RLL for new extract date range. "RTN","PRCHLO",71,0) ; CLOBGN will always be the beginning of the Fiscal Year (Oct 1st) "RTN","PRCHLO",72,0) ; This will be the start range for each extract. "RTN","PRCHLO",73,0) ; This routine is called through the option : "RTN","PRCHLO",74,0) ; [PRCHLO CLO PROCUREMENT] which is queued to run in TaskMan "RTN","PRCHLO",75,0) ; This option should be queued to run 2 hours AFTER "RTN","PRCHLO",76,0) ; [PRCHLO GIP OPTION] and should be run on the same day "RTN","PRCHLO",77,0) ; (after midnight) as the [PRCHLO GIP OPTION]. As an example: "RTN","PRCHLO",78,0) ; 1. Que [PRCHLO GIP OPTION] to run 12:00am the 1st of the month "RTN","PRCHLO",79,0) ; 2. Que [PRCHLO CLO PROCUREMENT] to run 1:00am the 1st of the month "RTN","PRCHLO",80,0) ; "RTN","PRCHLO",81,0) ; "RTN","PRCHLO",82,0) ; The following new Variables were added to the CALC entry point: "RTN","PRCHLO",83,0) ; YRRUN ; year option run "RTN","PRCHLO",84,0) ; PYRRUN ; previous year option run "RTN","PRCHLO",85,0) ; MTHRUN ; MONTHRUN "RTN","PRCHLO",86,0) ; listed below are 3 examples: "RTN","PRCHLO",87,0) ; "RTN","PRCHLO",88,0) ; Month Option Run | Date Range for Run | # of months of data "RTN","PRCHLO",89,0) ; Dec 1st, 2005 | Oct 1, 2005 to Dec 1st 2005| 2 "RTN","PRCHLO",90,0) ; Apr 1st, 2006 | Oct 1, 2005 to Apr 1st 2006| 6 "RTN","PRCHLO",91,0) ; Oct 1st, 2006 | Oct 1, 2005 to Oct 1st 2006| 12 "RTN","PRCHLO",92,0) ; "RTN","PRCHLO",93,0) STCLOBGN ; Set CLOBGN to Beginning of Fiscal Year (Oct. 1) "RTN","PRCHLO",94,0) ; "RTN","PRCHLO",95,0) I MTHRUN=12!(MTHRUN=11) D "RTN","PRCHLO",96,0) . ; For Nov or Dec, CLOBGN set to Begin of FY(Oct 1st) in same year "RTN","PRCHLO",97,0) . S CLOBGN=+(YRRUN_"10"_"00") "RTN","PRCHLO",98,0) . S CLOEND=% ; CLOEND is Date Extract Run "RTN","PRCHLO",99,0) . Q "RTN","PRCHLO",100,0) I (MTHRUN<11) D ; (CLOBGN set to Prev FY for all other conditions) "RTN","PRCHLO",101,0) . S CLOBGN=+(PYRRUN_"10"_"00") "RTN","PRCHLO",102,0) . S CLOEND=% ; CLOEND is Date Extract Run "RTN","PRCHLO",103,0) . Q "RTN","PRCHLO",104,0) ; (End new logic) "RTN","PRCHLO",105,0) ; "RTN","PRCHLO",106,0) DEBUGFY ; Debug Fiscal Year logic by uncommenting code below 7/31/06 RLL "RTN","PRCHLO",107,0) ; "RTN","PRCHLO",108,0) D GPARM "RTN","PRCHLO",109,0) ; Make sure ^TMP($J) is set with data, otherwise return error "RTN","PRCHLO",110,0) N CKTP "RTN","PRCHLO",111,0) S CKTP=$O(^TMP($J,0)) "RTN","PRCHLO",112,0) I CKTP="" D "RTN","PRCHLO",113,0) . S CLRSERR=1 ; error flag indicates no data in ^TMP($J) "RTN","PRCHLO",114,0) . Q "RTN","PRCHLO",115,0) Q "RTN","PRCHLO",116,0) ; "RTN","PRCHLO",117,0) GPARM ; Get parameters for monthly extract "RTN","PRCHLO",118,0) ; "RTN","PRCHLO",119,0) ; need to set monthyear for data file "RTN","PRCHLO",120,0) ; "RTN","PRCHLO",121,0) N MNTHYR,FMDT1,MYRVAL "RTN","PRCHLO",122,0) S FMDT1=$P(($$NOW^XLFDT),".",1) "RTN","PRCHLO",123,0) S MYRVAL=$$FMTE^XLFDT(FMDT1) "RTN","PRCHLO",124,0) S MNTHYR=$P(MYRVAL," ",1)_","_$P(MYRVAL," ",3) "RTN","PRCHLO",125,0) ; "RTN","PRCHLO",126,0) ; $O through the "AB" x-ref based on CLOBGN and CLOEND "RTN","PRCHLO",127,0) ; "RTN","PRCHLO",128,0) S CLO1=CLOBGN,CLO2="",CLO3="" "RTN","PRCHLO",129,0) F S CLO1=$O(^PRC(442,"AB",CLO1)) Q:CLO1="" D "RTN","PRCHLO",130,0) . F S CLO2=$O(^PRC(442,"AB",CLO1,CLO2)) Q:CLO2="" D "RTN","PRCHLO",131,0) . . Q:CLO1>(CLOEND-1) "RTN","PRCHLO",132,0) . . D GKEY "RTN","PRCHLO",133,0) . . Q "RTN","PRCHLO",134,0) . Q "RTN","PRCHLO",135,0) ; PRC*5.1*130 begin "RTN","PRCHLO",136,0) D GET410^PRCHLO6 "RTN","PRCHLO",137,0) D GET424^PRCHLO6 "RTN","PRCHLO",138,0) ; PRC*5.1*130 end "RTN","PRCHLO",139,0) Q "RTN","PRCHLO",140,0) EXTR ; Extract the data, create files "RTN","PRCHLO",141,0) ; "RTN","PRCHLO",142,0) GKEY ; get key for all tables "RTN","PRCHLO",143,0) N POID,POCRDAT "RTN","PRCHLO",144,0) S POID=CLO2 "RTN","PRCHLO",145,0) S POCRDAT=CLO1 ; PO Date from x-ref value "RTN","PRCHLO",146,0) D GPOMAST^PRCHLO1 ; "RTN","PRCHLO",147,0) Q "RTN","PRCHLO1") 0^4^B60133725^B28575897 "RTN","PRCHLO1",1,0) PRCHLO1 ;WOIFO/RLL-EXTRACT ROUTINE (cont.)CLO REPORT SERVER ;5/22/09 14:10 "RTN","PRCHLO1",2,0) ;;5.1;IFCAP;**83,130**;Oct 20, 2000;Build 25 "RTN","PRCHLO1",3,0) ;Per VHA Directive 2004-038, this routine should not be modified. "RTN","PRCHLO1",4,0) ; DBIA 10093 - Read file 49 via FileMan. "RTN","PRCHLO1",5,0) ; Continuation of PRCHLO1. This program builds the extracts for "RTN","PRCHLO1",6,0) ; the Master PO Table and the associated multiples "RTN","PRCHLO1",7,0) POMAST ; PoMaster Table "RTN","PRCHLO1",8,0) Q "RTN","PRCHLO1",9,0) PODISCW ; Write PO Discount table data "RTN","PRCHLO1",10,0) N GPOID,GPOND "RTN","PRCHLO1",11,0) S GPOID=0,GPOND="" "RTN","PRCHLO1",12,0) F S GPOID=$O(^TMP($J,"PODISC",GPOID)) Q:GPOID="" D "RTN","PRCHLO1",13,0) . F S GPOND=$O(^TMP($J,"PODISC",GPOID,GPOND)) Q:GPOND="" D "RTN","PRCHLO1",14,0) . . W $G(^TMP($J,"PODISC",GPOID,GPOND)) "RTN","PRCHLO1",15,0) . . W ! "RTN","PRCHLO1",16,0) . . Q "RTN","PRCHLO1",17,0) . Q "RTN","PRCHLO1",18,0) Q "RTN","PRCHLO1",19,0) GPOMAST ; get PO Master record "RTN","PRCHLO1",20,0) S U="^" "RTN","PRCHLO1",21,0) N N0,N1,N7,N12,N16,N23,PONUMB,STNUMB,PODAT,PPOKEY "RTN","PRCHLO1",22,0) N PAPAB,PAPAB1,AGAPO,AGAPO1,PCHDR,PCHDR1,PCUSR,PCUSR1,POIDC,PRCVAL "RTN","PRCHLO1",23,0) N VL1,VL6,VL7,VL8,VL9,VL10,VL11,VL12,VL13,VL14,VL15,VL16,VL17,VL18 "RTN","PRCHLO1",24,0) N VL19,VL20,VL21,VL22,VL23,VL24,VL25,VL26,VL27,VL28,VL29,VL30,VL31 "RTN","PRCHLO1",25,0) N VL32,VL33,VL34,VL35,VL36,VL37,VL38,VL39,VL40,VL41 "RTN","PRCHLO1",26,0) N GN0,GN0A,GN0B,GN1,GN1A,GN2,VN,VN1,VN2 "RTN","PRCHLO1",27,0) N VL6E,VL6E1,VL6E2,VL7E,VL7E1,VL7E2,VL8E,VL8E1,VL8E2,VL10E,VL10E1 "RTN","PRCHLO1",28,0) N VL10E2,VL21E,VL21E1,VL21E2,VL25E,VL25E1,VL25E2,VL35E,VL35E1,VL35E2 "RTN","PRCHLO1",29,0) N VL16E,VL16E1,VL16E2,VL18E,VL18E1,VL18E2,VL33E,VL33E1,VL33E2 "RTN","PRCHLO1",30,0) N VL34E,VL34E1,VL34E2,PC2237V,PC2237V1,EXDT,EXDT1,EXDT2 "RTN","PRCHLO1",31,0) S N0=$G(^PRC(442,POID,0)) "RTN","PRCHLO1",32,0) S N1=$G(^PRC(442,POID,1)) "RTN","PRCHLO1",33,0) S N7=$G(^PRC(442,POID,7)) "RTN","PRCHLO1",34,0) S N12=$G(^PRC(442,POID,12)) "RTN","PRCHLO1",35,0) S N16=$G(^PRC(442,POID,16)) "RTN","PRCHLO1",36,0) S N23=$G(^PRC(442,POID,23)) "RTN","PRCHLO1",37,0) S PONUMB=$P(N0,U,1),STNUMB=$P(PONUMB,"-",1) "RTN","PRCHLO1",38,0) S EXDT=$P(N1,U,15) "RTN","PRCHLO1",39,0) I EXDT="" S EXDT=POCRDAT ; if PO Date "" use x-ref date value for PO "RTN","PRCHLO1",40,0) S EXDT1=$P(EXDT,".",1) "RTN","PRCHLO1",41,0) S EXDT2=$$FMTE^XLFDT(EXDT1) "RTN","PRCHLO1",42,0) S PODAT=EXDT2 ; needed for key "RTN","PRCHLO1",43,0) S PPOKEY=POID_U_PONUMB_U_PODAT_U_MNTHYR_U_STNUMB "RTN","PRCHLO1",44,0) ; "RTN","PRCHLO1",45,0) ; The 1st 5 values in PPOKEY above are included in each record "RTN","PRCHLO1",46,0) ; "RTN","PRCHLO1",47,0) S VL6E=$P(N0,U,12),VL6E1=$G(^PRCS(410,+VL6E,0)),VL6E2=$P(VL6E1,U,1) "RTN","PRCHLO1",48,0) S VL6=VL6E2 ; Prim2237 "RTN","PRCHLO1",49,0) S VL7E=$P(N0,U,2),VL7E1=$G(^PRCD(442.5,+VL7E,0)),VL7E2=$P(VL7E1,U,1) "RTN","PRCHLO1",50,0) S VL7=VL7E2 ; meth.of proc "RTN","PRCHLO1",51,0) S VL8E=$P(N1,U,19),VL8E1=$G(^PRC(443.8,+VL8E,0)),VL8E2=$P(VL8E1,U,2) "RTN","PRCHLO1",52,0) S VL8=VL8E2 ; locProcRsnCode "RTN","PRCHLO1",53,0) S VL9=$P(N1,U,18) ; exp/non-exp "RTN","PRCHLO1",54,0) S VL10E=$P(N7,U,1),VL10E1=$G(^PRCD(442.3,+VL10E,0)) "RTN","PRCHLO1",55,0) S VL10E2=$P(VL10E1,U,1) "RTN","PRCHLO1",56,0) S VL10=VL10E2 ; Supply status "RTN","PRCHLO1",57,0) S VL11=$P(N7,U,2) ; Sup Stat Order "RTN","PRCHLO1",58,0) S VL12=$P(N7,U,4) ;Fis Stat Order "RTN","PRCHLO1",59,0) S VL13=$P(N0,U,3) ;FCP "RTN","PRCHLO1",60,0) S VL14=$P(N0,U,4) ;Appropriation "RTN","PRCHLO1",61,0) S VL15=$P(N0,U,5) ;CostCenter "RTN","PRCHLO1",62,0) S VL16E=$P(N0,U,6),VL16E1=$G(^PRCD(420.2,+VL16E,0)) "RTN","PRCHLO1",63,0) S VL16E2=$P(VL16E1,U,1) "RTN","PRCHLO1",64,0) S VL16=VL16E2 ;SubAcct1 "RTN","PRCHLO1",65,0) S VL17=$P(N0,U,7) ;SubAmt1 "RTN","PRCHLO1",66,0) S VL18E=$P(N0,U,8),VL18E1=$G(^PRCD(420.2,+VL18E,0)) "RTN","PRCHLO1",67,0) S VL18E2=$P(VL18E1,U,1) "RTN","PRCHLO1",68,0) S VL18=VL18E2 ;SubAcct2 "RTN","PRCHLO1",69,0) S VL19=$P(N0,U,9) ;SubAmt2 "RTN","PRCHLO1",70,0) ; set Node 0 of ^TMP "RTN","PRCHLO1",71,0) S GN0=PPOKEY_U_VL6_U_VL7_U_VL8_U_VL9_U_VL10_U "RTN","PRCHLO1",72,0) S GN0A=GN0_VL11_U_VL12_U_VL13_U_VL14_U_VL15_U "RTN","PRCHLO1",73,0) S GN0B=GN0A_VL16_U_VL17_U_VL18_U_VL19_U "RTN","PRCHLO1",74,0) S GN0B=GN0B_VL6E_U ;IEN OF PRIMARY 2237 "RTN","PRCHLO1",75,0) S GN0B=GN0B_VL7E_U ;IEN OF METHOD OF PROCESSING "RTN","PRCHLO1",76,0) S GN0B=GN0B_VL10E_U ;IEN OF SUPPLY STATUS "RTN","PRCHLO1",77,0) S GN0B=GN0B_VL16E_U ;IEN OF SUBACCOUNT1 "RTN","PRCHLO1",78,0) S GN0B=GN0B_VL18E_U ;IEN OF SUBACCOUNT2 "RTN","PRCHLO1",79,0) S ^TMP($J,"POMAST",POID,0)=GN0B ; build and set node 0 "RTN","PRCHLO1",80,0) ; begin Node 1 "RTN","PRCHLO1",81,0) ; look up Vendor "RTN","PRCHLO1",82,0) S VN=$P(N1,U,1),VN1=$G(^PRC(440,+VN,0)),VN2=$P(VN1,U,1) "RTN","PRCHLO1",83,0) S VL20=VN2 ;Vendor Name "RTN","PRCHLO1",84,0) S VL21E=$P(N1,U,2),VL21E1=$$GET1^DIQ(49,+VL21E_",",.01) "RTN","PRCHLO1",85,0) S VL21E2=$P(VL21E1,U,1) "RTN","PRCHLO1",86,0) S VL21=VL21E2 ; Req. Service "RTN","PRCHLO1",87,0) S VL22=$P(N1,U,6) ; Fob Point "RTN","PRCHLO1",88,0) ; get ext. date "RTN","PRCHLO1",89,0) S EXDT=$P(N0,U,20),EXDT1=$P(EXDT,".",1) "RTN","PRCHLO1",90,0) S EXDT2=$$FMTE^XLFDT(EXDT1) "RTN","PRCHLO1",91,0) S VL23=EXDT2 ; Org. Del. Date "RTN","PRCHLO1",92,0) S VL24=$P(N0,U,11) ; Est. Cost "RTN","PRCHLO1",93,0) S VL25E=$P(N1,U,7),VL25E1=$G(^PRCD(420.8,+VL25E,0)) "RTN","PRCHLO1",94,0) S VL25E2=$P(VL25E1,U,2) "RTN","PRCHLO1",95,0) S VL25=VL25E2 ; Source Code "RTN","PRCHLO1",96,0) S VL26=$P(N0,U,13) ; Est Shipping "RTN","PRCHLO1",97,0) S VL27=$P(N0,U,18) ; Shp Ln Itm # "RTN","PRCHLO1",98,0) S VL28=$P(N0,U,14) ; Ln Itm Cnt "RTN","PRCHLO1",99,0) S PAPAB=$P(N1,U,10),PAPAB1=$G(^VA(200,+PAPAB,0)) "RTN","PRCHLO1",100,0) S VL29=$P(PAPAB1,U,1) ; PaPpmAuthBuyer "RTN","PRCHLO1",101,0) S VL8=$P($G(^VA(200,+PAPAB,5)),"^") ;Service - PaPpmAuthBuyer "RTN","PRCHLO1",102,0) S VL9=$S(VL8="":"",1:$$GET1^DIQ(49,+VL8_",",.01)) ;SVC ext - PaPpmAuthBuyer "RTN","PRCHLO1",103,0) S AGAPO=$P(N12,U,4),AGAPO1=$G(^VA(200,+AGAPO,0)) "RTN","PRCHLO1",104,0) S VL30=$P(AGAPO1,U,1) ; Agt Assgnd PO "RTN","PRCHLO1",105,0) S VL6=$P($G(^VA(200,+AGAPO,5)),"^") ;Service - Agt Assgnd PO "RTN","PRCHLO1",106,0) S VL7=$S(VL6="":"",1:$$GET1^DIQ(49,+VL6_",",.01)) ;SVC ext - Agt Assgnd "RTN","PRCHLO1",107,0) ; get external date "RTN","PRCHLO1",108,0) S EXDT=$P(N12,U,5),EXDT1=$P(EXDT,".",1) "RTN","PRCHLO1",109,0) S EXDT2=$$FMTE^XLFDT(EXDT1) "RTN","PRCHLO1",110,0) S VL31=EXDT2 ; DatePoAssigned "RTN","PRCHLO1",111,0) S VL32=$P(N16,U,0) ;remarks "RTN","PRCHLO1",112,0) S VL33E=$P(N23,U,3),VL33E1=$G(^PRC(442,+VL33E,0)) "RTN","PRCHLO1",113,0) S VL33E2=$P(VL33E1,U,1) "RTN","PRCHLO1",114,0) S VL33=VL33E2 ; OldPoRec "RTN","PRCHLO1",115,0) S VL34E=$P(N23,U,4),VL34E1=$G(^PRC(442,+VL34E,0)) "RTN","PRCHLO1",116,0) S VL34E2=$P(VL34E1,U,1) "RTN","PRCHLO1",117,0) S VL34=$P(N23,U,4) ; New PoRec "RTN","PRCHLO1",118,0) S GN1=VL20_U_VL21_U_VL22_U_VL23_U_VL24_U_VL25_U_VL26_U_VL27_U "RTN","PRCHLO1",119,0) S GN1A=GN1_VL28_U_VL29_U_VL30_U_VL31_U_VL32_U_VL33_U_VL34_U "RTN","PRCHLO1",120,0) S GN1A=GN1A_VL8_U_VL9_U_AGAPO_U_VL6_U_VL7_U "RTN","PRCHLO1",121,0) S ^TMP($J,"POMAST",POID,1)=GN1A "RTN","PRCHLO1",122,0) ; "RTN","PRCHLO1",123,0) ; build node 2 "RTN","PRCHLO1",124,0) S VL35E=$P(N23,U,14),VL35E1=$G(^PRC(440,+VL35E,0)) "RTN","PRCHLO1",125,0) S VL35E2=$P(VL35E1,U,1) "RTN","PRCHLO1",126,0) S VL35=VL35E2 ; PcDo Vendor "RTN","PRCHLO1",127,0) S PCUSR=$P(N23,U,17),PCUSR1=$G(^VA(200,+PCUSR,0)) "RTN","PRCHLO1",128,0) S VL36=$P(PCUSR1,U,1) ; Pur Crd User "RTN","PRCHLO1",129,0) S VL6=$P($G(^VA(200,+PCUSR,5)),"^") ;Service - Pur Crd User "RTN","PRCHLO1",130,0) S VL7=$S(VL6="":"",1:$$GET1^DIQ(49,+VL6_",",.01)) ;SVC ext - Pur Crd User "RTN","PRCHLO1",131,0) S VL37=$P(N23,U,21) ; Pur Cost "RTN","PRCHLO1",132,0) S PCHDR=$P(N23,U,22),PCHDR1=$G(^VA(200,+PCHDR,0)) "RTN","PRCHLO1",133,0) S VL38=$P(PCHDR1,U,1) ; Pur Card Hldr "RTN","PRCHLO1",134,0) S VL8=$P($G(^VA(200,+PCHDR,5)),"^") ;Service - Pur Crd Hldr "RTN","PRCHLO1",135,0) S VL9=$S(VL8="":"",1:$$GET1^DIQ(49,+VL8_",",.01)) ;SVC ext - Pur Crd Hldr "RTN","PRCHLO1",136,0) ; get ext. value for 2237 "RTN","PRCHLO1",137,0) S PC2237V=$P(N23,U,23),PC2237V1=$G(^PRCS(410,+PC2237V,0)) "RTN","PRCHLO1",138,0) S VL39=$P(PC2237V1,U,1) ; Pcdo2237 "RTN","PRCHLO1",139,0) S VL40=$P(N0,U,15) ; Total Amount "RTN","PRCHLO1",140,0) S VL41=$P(N0,U,16) ; Net amount "RTN","PRCHLO1",141,0) ; "RTN","PRCHLO1",142,0) S GN2=VL35_U_VL36_U_VL37_U_VL38_U_VL39_U_VL40_U_VL41_U "RTN","PRCHLO1",143,0) S ^TMP($J,"POMAST",POID,2)=GN2_VL6_U_VL7_U_VL8_U_VL9_U "RTN","PRCHLO1",144,0) S VL20=$P(N23,U,2) S:VL20'="" VL20=$E(VL20+17000000,1,4) ;BBFY "RTN","PRCHLO1",145,0) S VL21=$$FMTE^XLFDT($P($P(N23,U,5),".")) ;END DATE FOR SERVICE ORDER "RTN","PRCHLO1",146,0) S VL19=$$GET1^DIQ(442,POID_",",30) ;AUTO ACCRUE "RTN","PRCHLO1",147,0) S VL22=$P(N23,U,7) ;SUBSTATION IEN "RTN","PRCHLO1",148,0) S VL23=$P($G(^PRC(411,+VL22,0)),U,1) ;SUBSTATION EXTERNAL "RTN","PRCHLO1",149,0) S VL24=VN ;VENDOR IEN "RTN","PRCHLO1",150,0) S VL25=$P($G(^PRC(440,+VN,3)),U,4) ;VENDOR FMS CODE "RTN","PRCHLO1",151,0) S VL26=$P($G(^PRC(440,+VN,3)),U,5) ;VENDOR ALT-ADDR-IND "RTN","PRCHLO1",152,0) S VL27=$P($G(^PRC(440,+VN,7)),U,12) ;VENDOR D & B "RTN","PRCHLO1",153,0) S VL28=$$GET1^DIQ(442,POID,21) ;MONTH "RTN","PRCHLO1",154,0) S VL29=$$GET1^DIQ(442,POID,22) ;QUARTER "RTN","PRCHLO1",155,0) S VL30=$$GET1^DIQ(442,POID,23) ;LAST DIGIT OF FISCAL YEAR "RTN","PRCHLO1",156,0) S GN1=VL20_U_VL21_U_VL19_U_VL22_U_VL23_U_VL24_U_VL25_U_VL26_U_VL27 "RTN","PRCHLO1",157,0) S ^TMP($J,"POMAST",POID,3)=GN1_U_VL28_U_VL29_U_VL30_U "RTN","PRCHLO1",158,0) S N1=$G(^PRC(442,POID,8)) D "RTN","PRCHLO1",159,0) . S VL20=$P(N1,U,1) ;ACTUAL 1358 BALANCE "RTN","PRCHLO1",160,0) . S VL21=$P(N1,U,2) ;FISCAL 1358 BALANCE "RTN","PRCHLO1",161,0) . S VL22=$P(N1,U,3) ;ESTIMATED 1358 BALANCE "RTN","PRCHLO1",162,0) . S VL23=$$GET1^DIQ(442,POID_",",96.7) ;BULLETIN SENT "RTN","PRCHLO1",163,0) S VL24=$P($G(^PRC(442,POID,24)),U,3) ;INTERFACE PACKAGE PREFIX "RTN","PRCHLO1",164,0) S VL25=$P($G(^PRC(442,POID,18)),U,3) ;DOCUMENT IDENTIFIER/COMMON # "RTN","PRCHLO1",165,0) S VL26=$$GET1^DIQ(442,POID_",",116) ;DO YOU WANT TO SEND THIS EDI? "RTN","PRCHLO1",166,0) S GN1=VL20_U_VL21_U_VL22_U_VL23_U_VL24_U_VL25_U_VL26_U "RTN","PRCHLO1",167,0) S ^TMP($J,"POMAST",POID,4)=GN1 "RTN","PRCHLO1",168,0) K PRCVAL,POIDC S POIDC=POID_"," "RTN","PRCHLO1",169,0) D GETS^DIQ(442,POIDC,"117:132","E","PRCVAL") "RTN","PRCHLO1",170,0) S GN1="" "RTN","PRCHLO1",171,0) F VL1=117:1:132 S GN1=GN1_$G(PRCVAL(442,POIDC,VL1,"E"))_U "RTN","PRCHLO1",172,0) K PRCVAL,POIDC "RTN","PRCHLO1",173,0) S GN1=GN1_$P($G(^PRC(442,POID,25)),U,17)_U ; SEND TO FPDS? "RTN","PRCHLO1",174,0) S $P(GN1,U,18,20)=PAPAB_U_$P(N23,U,17)_U_$P(N23,U,22) "RTN","PRCHLO1",175,0) S $P(GN1,U,21)=$$GET^XPAR("SYS","PRCPLO REGIONAL ACQ CENTER",1,"Q") "RTN","PRCHLO1",176,0) S ^TMP($J,"POMAST",POID,5)=GN1 ;NODE 25, TOTAL OF 17 FIELDS "RTN","PRCHLO1",177,0) ; "RTN","PRCHLO1",178,0) D PODISC^PRCHLO1A "RTN","PRCHLO1",179,0) D POBOC^PRCHLO1A "RTN","PRCHLO1",180,0) D POCMTS^PRCHLO1A "RTN","PRCHLO1",181,0) D PORMKS^PRCHLO1A "RTN","PRCHLO1",182,0) D PO2237^PRCHLO1A "RTN","PRCHLO1",183,0) D POAMT^PRCHLO1A "RTN","PRCHLO1",184,0) D POAMMD^PRCHLO1A "RTN","PRCHLO1",185,0) D POPPTER^PRCHLO2A "RTN","PRCHLO1",186,0) D POPART^PRCHLO2A "RTN","PRCHLO1",187,0) D POOBL^PRCHLO2A "RTN","PRCHLO1",188,0) D POPMET^PRCHLO2A "RTN","PRCHLO1",189,0) D GPOITEM^PRCHLO2 "RTN","PRCHLO1",190,0) Q "RTN","PRCHLO1",191,0) PODISCH ; PO Discount Header File "RTN","PRCHLO1",192,0) ; Header file for PO Discount Multiple "RTN","PRCHLO1",193,0) W "PoIdNum^PurchaseOrderNum^PoDate^MonthYrRun^StationNum^" "RTN","PRCHLO1",194,0) W "DiscountIdNum^DiscountItem^PercentDollarAmount^" "RTN","PRCHLO1",195,0) W "DiscountAmount^ItemCount^Contract^LineItem",! "RTN","PRCHLO1",196,0) Q "RTN","PRCHLO1A") 0^5^B77634009^B66700839 "RTN","PRCHLO1A",1,0) PRCHLO1A ;WOIFO/RLL-EXTRACT ROUTINE (cont.)CLO REPORT SERVER ;5/22/09 14:11 "RTN","PRCHLO1A",2,0) ;;5.1;IFCAP;**83,130**;Oct 20, 2000;Build 25 "RTN","PRCHLO1A",3,0) ;Per VHA Directive 2004-038, this routine should not be modified. "RTN","PRCHLO1A",4,0) ; DBIA 10093 - Read file 49 via FileMan. "RTN","PRCHLO1A",5,0) ; Continuation of PRCHLO1. This program builds the extracts for "RTN","PRCHLO1A",6,0) ; the Master PO Table and the associated multiples "RTN","PRCHLO1A",7,0) POMAST ; PoMaster Table "RTN","PRCHLO1A",8,0) Q "RTN","PRCHLO1A",9,0) PODISCW ; Write PO Discount table data "RTN","PRCHLO1A",10,0) N GPOID,GPOND "RTN","PRCHLO1A",11,0) S GPOID=0,GPOND="" "RTN","PRCHLO1A",12,0) F S GPOID=$O(^TMP($J,"PODISC",GPOID)) Q:GPOID="" D "RTN","PRCHLO1A",13,0) . F S GPOND=$O(^TMP($J,"PODISC",GPOID,GPOND)) Q:GPOND="" D "RTN","PRCHLO1A",14,0) . . W $G(^TMP($J,"PODISC",GPOID,GPOND)) "RTN","PRCHLO1A",15,0) . . W ! "RTN","PRCHLO1A",16,0) . . Q "RTN","PRCHLO1A",17,0) . Q "RTN","PRCHLO1A",18,0) W ! "RTN","PRCHLO1A",19,0) Q "RTN","PRCHLO1A",20,0) PODISC ; "RTN","PRCHLO1A",21,0) ;PoDiscount Table 442.03A (multiple) "RTN","PRCHLO1A",22,0) ; ^PRC(442,POID,3,0)=^442.03A "RTN","PRCHLO1A",23,0) N CKDS,PPO,PPOVAL,CKDS1,V1,V2,V3,V4,V5,V6 "RTN","PRCHLO1A",24,0) S CKDS=$G(^PRC(442,POID,3,0)),PPO=0 "RTN","PRCHLO1A",25,0) S CKDS1=$P(CKDS,U,3) "RTN","PRCHLO1A",26,0) I +CKDS1>0 D ; Contains at least one discount, create rec. "RTN","PRCHLO1A",27,0) . D LPPODIS "RTN","PRCHLO1A",28,0) . Q "RTN","PRCHLO1A",29,0) Q "RTN","PRCHLO1A",30,0) PO2237 ; 2237RefNum Table "RTN","PRCHLO1A",31,0) N CK2237,PPO,PPOVAL,CK2237A,PPV4E1,PPV4E2 "RTN","PRCHLO1A",32,0) S CK2237=$G(^PRC(442,POID,13,0)),PPO=0 "RTN","PRCHLO1A",33,0) S CK2237A=$P(CK2237,U,3) "RTN","PRCHLO1A",34,0) I +CK2237A>0 D ; Contains at least one 2237#, create rec "RTN","PRCHLO1A",35,0) . D LP2237 "RTN","PRCHLO1A",36,0) Q "RTN","PRCHLO1A",37,0) POBOC ; PoBoc Table "RTN","PRCHLO1A",38,0) N CKBS,PPO,PPOVAL,PPOVAL1,CKBS1 "RTN","PRCHLO1A",39,0) S CKBS=$G(^PRC(442,POID,22,0)),PPO=0 "RTN","PRCHLO1A",40,0) S CKBS1=$P(CKBS,U,3) "RTN","PRCHLO1A",41,0) I +CKBS1>0 D ; Contains at lease one BOC, create rec. "RTN","PRCHLO1A",42,0) . D LPPOBC "RTN","PRCHLO1A",43,0) Q "RTN","PRCHLO1A",44,0) POAMT ; PO Amount table (multiple) "RTN","PRCHLO1A",45,0) N POAMT,POAMT1,POAMT2,POAMT3,POAMT4,V1,V2,V3 "RTN","PRCHLO1A",46,0) N V1E,V1E1,V1E2,V2E,V2E1,V2E2,VE,VE1,VE2 "RTN","PRCHLO1A",47,0) S POAMT=$G(^PRC(442,POID,9,0)) "RTN","PRCHLO1A",48,0) S POAMT1=$P(POAMT,U,3) "RTN","PRCHLO1A",49,0) I +POAMT1>0 D "RTN","PRCHLO1A",50,0) . S POAMT2=0 "RTN","PRCHLO1A",51,0) . F S POAMT2=$O(^PRC(442,POID,9,POAMT2)) Q:POAMT2="" D "RTN","PRCHLO1A",52,0) . . Q:+POAMT2<0 "RTN","PRCHLO1A",53,0) . . S POAMT3=$G(^PRC(442,POID,9,POAMT2,0)) "RTN","PRCHLO1A",54,0) . . Q:POAMT3="" "RTN","PRCHLO1A",55,0) . . ; For V1-V3, Get the node, $P the data, pad with "^" delimiters "RTN","PRCHLO1A",56,0) . . ; get external value for TypeCode "RTN","PRCHLO1A",57,0) . . S VE=$P(POAMT3,U,2) "RTN","PRCHLO1A",58,0) . . I VE'="" S VE1=$G(^PRCD(420.6,+VE,0)),VE2=$P(VE1,U,1) "RTN","PRCHLO1A",59,0) . . I VE="" S VE2="" "RTN","PRCHLO1A",60,0) . . ; get external value for CompStatus Business "RTN","PRCHLO1A",61,0) . . S V1E=$P(POAMT3,U,4) "RTN","PRCHLO1A",62,0) . . I V1E'="" S V1E1=$G(^PRCD(420.6,+V1E,0)),V1E2=$P(V1E1,U,1) "RTN","PRCHLO1A",63,0) . . I V1E="" S V1E2="" "RTN","PRCHLO1A",64,0) . . ; "RTN","PRCHLO1A",65,0) . . S V1=$P(POAMT3,U,1)_U_VE2_U_V1E2_U "RTN","PRCHLO1A",66,0) . . ; Get external value for PrefProgram "RTN","PRCHLO1A",67,0) . . S V2E=$P(POAMT3,U,5) "RTN","PRCHLO1A",68,0) . . I V2E'="" S V2E1=$G(^PRCD(420.6,+V2E,0)),V2E2=$P(V2E1,U,1) "RTN","PRCHLO1A",69,0) . . I V2E="" S V2E2="" "RTN","PRCHLO1A",70,0) . . S V2=V2E2_U_$P(POAMT3,U,3),V3=V1_V2 "RTN","PRCHLO1A",71,0) . . S POAMT4=PPOKEY_U_POAMT2_U_V3 "RTN","PRCHLO1A",72,0) . . I +POAMT2>0 S ^TMP($J,"POAMT",POID,POAMT2,0)=POAMT4 "RTN","PRCHLO1A",73,0) . . D PAMBCD ; Po Amount Breakout code "RTN","PRCHLO1A",74,0) . . Q "RTN","PRCHLO1A",75,0) . Q "RTN","PRCHLO1A",76,0) Q "RTN","PRCHLO1A",77,0) PAMBCD ; PO Amount Breakout code "RTN","PRCHLO1A",78,0) N PAMBC,PAMBC1,PAMBC2,PAMBC3,PAMBC4,VBCE,VBCE1,VBCE2 "RTN","PRCHLO1A",79,0) S PAMBC=0,PAMBC1=0,PAMBC2=0,PAMBC3=0 "RTN","PRCHLO1A",80,0) S PAMBC=$G(^PRC(442,POID,9,POAMT2,1,0)) "RTN","PRCHLO1A",81,0) S PAMBC1=$P(PAMBC,U,3) "RTN","PRCHLO1A",82,0) I +PAMBC1>0 D "RTN","PRCHLO1A",83,0) . F S PAMBC2=$O(^PRC(442,POID,9,POAMT2,1,PAMBC2)) Q:PAMBC2="" D "RTN","PRCHLO1A",84,0) . . Q:+PAMBC2<0 "RTN","PRCHLO1A",85,0) . . S PAMBC3=$G(^PRC(442,POID,9,POAMT2,1,PAMBC2,0)) "RTN","PRCHLO1A",86,0) . . ; "RTN","PRCHLO1A",87,0) . . ; get external value for breakout code "RTN","PRCHLO1A",88,0) . . S VBCE=$P(PAMBC3,U,1) "RTN","PRCHLO1A",89,0) . . I VBCE'="" S VBCE1=$G(^PRCD(420.6,+VBCE,0)),VBCE2=$P(VBCE1,U,1) "RTN","PRCHLO1A",90,0) . . I VBCE="" S VBCE2="" "RTN","PRCHLO1A",91,0) . . S PAMBC4=PPOKEY_U_POAMT2_U_PAMBC2_U_VBCE2 "RTN","PRCHLO1A",92,0) . . I +PAMBC2>0 S ^TMP($J,"POBKCOD",POID,POAMT2,PAMBC2,0)=PAMBC4 "RTN","PRCHLO1A",93,0) . . Q "RTN","PRCHLO1A",94,0) . Q "RTN","PRCHLO1A",95,0) Q "RTN","PRCHLO1A",96,0) POAMMD ; PO Amendment Table (multiple) "RTN","PRCHLO1A",97,0) N POAMD,POAMD1,POAMD2,POAMD3,POAMD3A,POAMD4,V1,V2,V3,V2E,V2E1,V2E2 "RTN","PRCHLO1A",98,0) N V3E,V3E1,V3E2,V1E,V1E1,V1E2,VL6,VL7,VL8,VL9 "RTN","PRCHLO1A",99,0) S POAMD=$G(^PRC(442,POID,6,0)) "RTN","PRCHLO1A",100,0) S POAMD1=$P(POAMD,U,3) "RTN","PRCHLO1A",101,0) S POAMD2=0 "RTN","PRCHLO1A",102,0) F S POAMD2=$O(^PRC(442,POID,6,POAMD2)) Q:+POAMD2'>0 D "RTN","PRCHLO1A",103,0) . S POAMD3=$G(^PRC(442,POID,6,POAMD2,0)) "RTN","PRCHLO1A",104,0) . S POAMD3A=$G(^PRC(442,POID,6,POAMD2,1)) "RTN","PRCHLO1A",105,0) . ; V1-V3, $Get the data, $P the values, pad with "^" delimiters "RTN","PRCHLO1A",106,0) . ; get external date for EffectiveDate "RTN","PRCHLO1A",107,0) . S V1E=$P(POAMD3,U,2),V1E1=$P(V1E,".",1) "RTN","PRCHLO1A",108,0) . I V1E'="" S V1E2=$$FMTE^XLFDT(V1E1) "RTN","PRCHLO1A",109,0) . I V1E="" S V1E2="" "RTN","PRCHLO1A",110,0) . S V1=$P(POAMD3,U,1)_U_V1E2_U_$P(POAMD3,U,3)_U "RTN","PRCHLO1A",111,0) . ; get external value for pAPPMaUthorizedBuyer "RTN","PRCHLO1A",112,0) . S V2E=$P(POAMD3A,U,1) "RTN","PRCHLO1A",113,0) . I V2E'="" S V2E1=$G(^VA(200,+V2E,0)),V2E2=$P(V2E1,U,1) "RTN","PRCHLO1A",114,0) . I V2E="" S V2E2="" "RTN","PRCHLO1A",115,0) . S VL8=$P($G(^VA(200,+V2E,5)),U) ;SERVICE - pAPPMaUthorizedBuyer "RTN","PRCHLO1A",116,0) . S VL9=$S(VL8="":"",1:$$GET1^DIQ(49,+VL8_",",.01)) ;SVC ext - pAPPMaUthorizedBuyer "RTN","PRCHLO1A",117,0) . ; get external value for AmendmentAdjustment "RTN","PRCHLO1A",118,0) . S V3E=$P(POAMD3A,U,4) "RTN","PRCHLO1A",119,0) . I V3E'="" S V3E1=$G(^PRCD(442.3,+V3E,0)),V3E2=$P(V3E1,U,1) "RTN","PRCHLO1A",120,0) . I V3E="" S V3E2="" "RTN","PRCHLO1A",121,0) . S VL6=$P(POAMD3A,U,5),VL7=$P($G(^VA(200,+VL6,0)),U) ;Fiscal Approv "RTN","PRCHLO1A",122,0) . S V2=V2E2_U_V3E2,V3=V1_V2_U_V2E_U_VL6_U_VL7 "RTN","PRCHLO1A",123,0) . S V1=$P($G(^VA(200,+VL6,5)),U) ;SERVICE - Fiscal Approv "RTN","PRCHLO1A",124,0) . S V2=$S(V1="":"",1:$$GET1^DIQ(49,+V1_",",.01)) ;SVC ext - Fiscal Approv "RTN","PRCHLO1A",125,0) . S POAMD4=PPOKEY_U_POAMD2_U_V3_U_VL8_U_VL9_U_V1_U_V2 "RTN","PRCHLO1A",126,0) . S ^TMP($J,"POAMMD",POID,POAMD2,0)=POAMD4 "RTN","PRCHLO1A",127,0) . D POAMCH ; Check for Amendment Changes "RTN","PRCHLO1A",128,0) . D POAMDS ; Check for Amendment Description "RTN","PRCHLO1A",129,0) . Q "RTN","PRCHLO1A",130,0) Q "RTN","PRCHLO1A",131,0) POAMCH ; PO Amendment Changes Table (mulitple) "RTN","PRCHLO1A",132,0) N POAMC,POAMC1,POAMC2,POAMC3,POAMC4,POAMC5,POAMC6 "RTN","PRCHLO1A",133,0) S POAMC=$G(^PRC(442,POID,6,POAMD2,3,0)) "RTN","PRCHLO1A",134,0) S POAMC1=$P(POAMC,U,3) "RTN","PRCHLO1A",135,0) S POAMC2=0 "RTN","PRCHLO1A",136,0) F S POAMC2=$O(^PRC(442,POID,6,POAMD2,3,POAMC2)) Q:+POAMC2'>0 D "RTN","PRCHLO1A",137,0) . S POAMC3=$G(^PRC(442,POID,6,POAMD2,3,POAMC2,0)) "RTN","PRCHLO1A",138,0) . S POAMC4=$P(POAMC3,U,1),POAMC5=$P(POAMC3,U,2) "RTN","PRCHLO1A",139,0) . S POAMC6=PPOKEY_U_POAMD2_U_POAMC2_U_POAMC4_U_POAMC5 "RTN","PRCHLO1A",140,0) . S ^TMP($J,"POAMMDCH",POID,POAMD2,POAMC2,0)=POAMC6 "RTN","PRCHLO1A",141,0) . Q "RTN","PRCHLO1A",142,0) Q "RTN","PRCHLO1A",143,0) POAMDS ; PO Amendment Description Table "RTN","PRCHLO1A",144,0) N POADD,POADD1,POADD2,POADD3,POADD4 "RTN","PRCHLO1A",145,0) S POADD=$G(^PRC(442,POID,6,POAMD2,2,0)) "RTN","PRCHLO1A",146,0) I $D(POADD) D "RTN","PRCHLO1A",147,0) . S POADD1=0 "RTN","PRCHLO1A",148,0) . F S POADD1=$O(^PRC(442,POID,6,POAMD2,2,POADD1)) Q:POADD1="" D "RTN","PRCHLO1A",149,0) . . S POADD2=$G(^PRC(442,POID,6,POAMD2,2,POADD1,0)) ; mult "RTN","PRCHLO1A",150,0) . . S POADD3=PPOKEY_U_POAMD2_U_POADD1_U_POADD2 "RTN","PRCHLO1A",151,0) . . Q:+POADD1>1 ; Get the 1st "1" "RTN","PRCHLO1A",152,0) . . I +POAMD2>0 S ^TMP($J,"POAMMDDES",POID,POAMD2,POADD1,0)=POADD3 "RTN","PRCHLO1A",153,0) . . Q "RTN","PRCHLO1A",154,0) . Q "RTN","PRCHLO1A",155,0) Q "RTN","PRCHLO1A",156,0) POCMTS ; PocommentsTable "RTN","PRCHLO1A",157,0) N POCMTS,POCMTS1 "RTN","PRCHLO1A",158,0) S POCMTS=$G(^PRC(442,POID,4,1,0)) ; 1st line "RTN","PRCHLO1A",159,0) S POCMTS1=$E(POCMTS,1,175) ; Get the 1st 175 Chars "RTN","PRCHLO1A",160,0) ; Get the 1st 175 Char of 1st comment only "RTN","PRCHLO1A",161,0) I POCMTS'="" S ^TMP($J,"POCOMMENTS",POID)=PPOKEY_U_1_U_POCMTS1 "RTN","PRCHLO1A",162,0) Q "RTN","PRCHLO1A",163,0) PORMKS ; PoRemarks Table "RTN","PRCHLO1A",164,0) N PORMKS,PORMKS1 "RTN","PRCHLO1A",165,0) S PORMKS=$G(^PRC(442,POID,16,1,0)) ; 1st Line, 1st Comment "RTN","PRCHLO1A",166,0) S PORMKS1=$E(PORMKS,1,175) ; Get the 1st 175 Chars "RTN","PRCHLO1A",167,0) ; gET 1st 175 Characters of 1st remark "RTN","PRCHLO1A",168,0) I PORMKS'="" S ^TMP($J,"POREMARKS",POID)=PPOKEY_U_1_U_PORMKS1 "RTN","PRCHLO1A",169,0) Q "RTN","PRCHLO1A",170,0) LPPODIS ; Loop on PO Discount "RTN","PRCHLO1A",171,0) I CKDS1>0 D "RTN","PRCHLO1A",172,0) . F S PPO=$O(^PRC(442,POID,3,PPO)) Q:PPO="" D "RTN","PRCHLO1A",173,0) . . S PPOVAL=$G(^PRC(442,POID,3,PPO,0)) "RTN","PRCHLO1A",174,0) . . S V1=$P(PPOVAL,U,1)_U_$P(PPOVAL,U,2)_U ; disc itm & %$tot "RTN","PRCHLO1A",175,0) . . S V2=$P(PPOVAL,U,3)_U_$P(PPOVAL,U,4)_U ; DiscAmt & ItmCt "RTN","PRCHLO1A",176,0) . . S V3=$P(PPOVAL,U,5)_U_$P(PPOVAL,U,6) ; contract & lineItem "RTN","PRCHLO1A",177,0) . . S V4=V1_V2_V3 ; all data "RTN","PRCHLO1A",178,0) . . S PPOVAL1=PPOKEY_U_PPO_U_V4 "RTN","PRCHLO1A",179,0) . . S ^TMP($J,"PODISC",POID,PPO)=PPOVAL1 "RTN","PRCHLO1A",180,0) . . Q "RTN","PRCHLO1A",181,0) . Q "RTN","PRCHLO1A",182,0) Q "RTN","PRCHLO1A",183,0) LPPOBC ; Loop PoBoc Table "RTN","PRCHLO1A",184,0) F S PPO=$O(^PRC(442,POID,22,PPO)) Q:PPO="" D "RTN","PRCHLO1A",185,0) . Q:PPO="B" ; don't want B index "RTN","PRCHLO1A",186,0) . S PPOVAL=$G(^PRC(442,POID,22,PPO,0)) "RTN","PRCHLO1A",187,0) . S PPOVAL1=$P(PPOVAL,U,1)_U_$P(PPOVAL,U,2) "RTN","PRCHLO1A",188,0) . S PPOVAL1=PPOVAL1_U_$P(PPOVAL,U,3) ;FMS LINE "RTN","PRCHLO1A",189,0) . S PPOVAL2=PPOKEY_U_PPO_U_PPOVAL1 "RTN","PRCHLO1A",190,0) . S ^TMP($J,"POBOC",POID,PPO)=PPOVAL2 "RTN","PRCHLO1A",191,0) . Q "RTN","PRCHLO1A",192,0) Q "RTN","PRCHLO1A",193,0) LP2237 ; Loop 2237 "RTN","PRCHLO1A",194,0) N PPOVAL,PPV1,PPV2,PPV3,PPV4,PPV5,PPV6,PPV7,PPVALL,POKEY,PPOVAL2 "RTN","PRCHLO1A",195,0) N PPV1E,PPV1E1,PPV2E,PPV2E1,PPV4E1,PPV4E2,PPV7E,PPV7E1,PPV7E2 "RTN","PRCHLO1A",196,0) N PPV3E,PPV3E1,VL6,VL7,VL8,VL9 "RTN","PRCHLO1A",197,0) F S PPO=$O(^PRC(442,POID,13,PPO)) Q:PPO="" D "RTN","PRCHLO1A",198,0) . S PPOVAL=$G(^PRC(442,POID,13,PPO,0)) "RTN","PRCHLO1A",199,0) . S PPV1=$P(PPOVAL,U,1),PPV2=$P(PPOVAL,U,2),PPV3=$P(PPOVAL,U,4) "RTN","PRCHLO1A",200,0) . ; external value for 2237 PPV1 "RTN","PRCHLO1A",201,0) . I PPV1'="" S PPV1E=$G(^PRCS(410,+PPV1,0)),PPV1E1=$P(PPV1E,U,1) "RTN","PRCHLO1A",202,0) . I PPV1="" S PPV1E1="" "RTN","PRCHLO1A",203,0) . ; external value for Accountable Officer PPV2 "RTN","PRCHLO1A",204,0) . I PPV2'="" S PPV2E=$G(^VA(200,+PPV2,0)),PPV2E1=$P(PPV2E,U,1) "RTN","PRCHLO1A",205,0) . I PPV2="" S PPV2E1="" "RTN","PRCHLO1A",206,0) . S VL6=$P($G(^VA(200,+PPV2,5)),"^") ;Service - Acc Office "RTN","PRCHLO1A",207,0) . S VL7=$S(VL6="":"",1:$$GET1^DIQ(49,+VL6_",",.01)) ;SVC ext - Acc Office "RTN","PRCHLO1A",208,0) . ; ext. date value for Date Signed "RTN","PRCHLO1A",209,0) . I PPV3'="" S PPV3E=$P(PPV3,".",1),PPV3E1=$$FMTE^XLFDT(PPV3E) "RTN","PRCHLO1A",210,0) . I PPV3="" S PPV3E1="" "RTN","PRCHLO1A",211,0) . S PPV4=$P(PPOVAL,U,5),PPV5=$P(PPOVAL,U,9),PPV6=$P(PPOVAL,U,10) "RTN","PRCHLO1A",212,0) . ; external for Purchasing agent PPV4 "RTN","PRCHLO1A",213,0) . ; "RTN","PRCHLO1A",214,0) . I PPV4'="" S PPV4E1=$G(^VA(200,+PPV4,0)),PPV4E2=$P(PPV4E1,U,1) "RTN","PRCHLO1A",215,0) . I PPV4="" S PPV4E2="" "RTN","PRCHLO1A",216,0) . S VL8=$P($G(^VA(200,+PPV4,5)),"^") ;Service - Purchase Agent "RTN","PRCHLO1A",217,0) . S VL9=$S(VL8="":"",1:$$GET1^DIQ(49,+VL8_",",.01)) ;SVC ext - Purchase Agent "RTN","PRCHLO1A",218,0) . ; get external value for InvDistPoint "RTN","PRCHLO1A",219,0) . S PPV7E=$P(PPOVAL,U,11) "RTN","PRCHLO1A",220,0) . I PPV7E'="" S PPV7E1=$G(^PRCP(445,+PPV7E,0)),PPV7E2=$P(PPV7E1,U,1) "RTN","PRCHLO1A",221,0) . I PPV7E="" S PPV7E2="" "RTN","PRCHLO1A",222,0) . S PPV7=PPV7E2 "RTN","PRCHLO1A",223,0) . S PPVALL=PPV1E1_U_PPV2E1_U_PPV3E1_U_PPV4E2_U_PPV5_U_PPV6_U_PPV7_U_$P(PPOVAL,U,5)_U_$P(PPOVAL,U,2) "RTN","PRCHLO1A",224,0) . ; "RTN","PRCHLO1A",225,0) . S PPOVAL2=PPOKEY_U_PPO_U_PPVALL "RTN","PRCHLO1A",226,0) . S ^TMP($J,"PO2237",POID,PPO)=PPOVAL2_U_VL8_U_VL9_U_VL6_U_VL7 "RTN","PRCHLO1A",227,0) . Q "RTN","PRCHLO1A",228,0) Q "RTN","PRCHLO1A",229,0) PODISCH ; PO Discount Header File "RTN","PRCHLO1A",230,0) ; Header file for PO Discount Multiple "RTN","PRCHLO1A",231,0) W "PoIdNum^PurchaseOrderNum^PoDate^MonthYrRun^StationNum^" "RTN","PRCHLO1A",232,0) W "DiscountIdNum^DiscountItem^PercentDollarAmount^" "RTN","PRCHLO1A",233,0) W "DiscountAmount^ItemCount^Contract^LineItem",! "RTN","PRCHLO1A",234,0) Q "RTN","PRCHLO2A") 0^7^B28866192^B22564489 "RTN","PRCHLO2A",1,0) PRCHLO2A ;WOIFO/RLL/DAP-EXTRACT ROUTINE (cont.)CLO REPORT SERVER ;5/22/09 14:12 "RTN","PRCHLO2A",2,0) ;;5.1;IFCAP;**83,130**;Oct 20, 2000;Build 25 "RTN","PRCHLO2A",3,0) ;Per VHA Directive 2004-038, this routine should not be modified. "RTN","PRCHLO2A",4,0) ; DBIA 10093 - Read file 49 via FileMan. "RTN","PRCHLO2A",5,0) ; Continuation of PRCHLO2. This program includes the extract "RTN","PRCHLO2A",6,0) ; logic for each of the identified tables. "RTN","PRCHLO2A",7,0) ; "RTN","PRCHLO2A",8,0) Q "RTN","PRCHLO2A",9,0) ; "RTN","PRCHLO2A",10,0) POOBL ; PO Obligation data "RTN","PRCHLO2A",11,0) ;PoObligationData Table 442.09 (multiple) "RTN","PRCHLO2A",12,0) ; ^PRC(442,POID,10,0)=^442.09 "RTN","PRCHLO2A",13,0) ; "RTN","PRCHLO2A",14,0) N CKOB,PPO,PPOVAL,CKOB1,PP1,PP2,PP3,PP4,PP5,PP5E1,PP5E2,PP1A,PPALL "RTN","PRCHLO2A",15,0) N PP2E1,PP2E2 "RTN","PRCHLO2A",16,0) S CKOB=$G(^PRC(442,POID,10,0)),PPO=0 "RTN","PRCHLO2A",17,0) ; "RTN","PRCHLO2A",18,0) S CKOB1=$P(CKOB,U,3) "RTN","PRCHLO2A",19,0) ; "RTN","PRCHLO2A",20,0) I +CKOB1>0 D ; Contains at least one Obligation, create rec. "RTN","PRCHLO2A",21,0) . ; "RTN","PRCHLO2A",22,0) . D LPPOOB "RTN","PRCHLO2A",23,0) . Q "RTN","PRCHLO2A",24,0) Q "RTN","PRCHLO2A",25,0) POPART ; PO Partial "RTN","PRCHLO2A",26,0) ; "RTN","PRCHLO2A",27,0) N CKPT,PPO,CKPT1,CKPT2 "RTN","PRCHLO2A",28,0) S CKPT=$G(^PRC(442,POID,11,0)),PPO=0 "RTN","PRCHLO2A",29,0) S CKPT2=$P(CKPT,U,3) "RTN","PRCHLO2A",30,0) I +CKPT2>0 D ; Contains at least one PARTIAL, create rec "RTN","PRCHLO2A",31,0) . D LPPART "RTN","PRCHLO2A",32,0) Q "RTN","PRCHLO2A",33,0) POPMET ; PoPurchaseMethod Table "RTN","PRCHLO2A",34,0) N CKPM,PPO,PPOVAL,CKPM1,PPOVAL1E,PPOVAL2E "RTN","PRCHLO2A",35,0) S CKPM=$G(^PRC(442,POID,14,0)),PPO=0 "RTN","PRCHLO2A",36,0) S CKPM1=$P(CKPM,U,3) "RTN","PRCHLO2A",37,0) I +CKPM1>0 D ; Contains at lease one Purchase Method, create rec. "RTN","PRCHLO2A",38,0) . D LPPM "RTN","PRCHLO2A",39,0) Q "RTN","PRCHLO2A",40,0) POPPTER ; PopromptpaymentTermsTable "RTN","PRCHLO2A",41,0) N POPPT,POPPT1,PPO,PPOVAL,PPOVAL1 "RTN","PRCHLO2A",42,0) S POPPT=$G(^PRC(442,POID,5,0)) "RTN","PRCHLO2A",43,0) S POPPT1=$P(POPPT,U,3) "RTN","PRCHLO2A",44,0) I +POPPT1>0 D ;Contains at least one PromptPayment Term, create rec "RTN","PRCHLO2A",45,0) . D LPPOPTR "RTN","PRCHLO2A",46,0) Q "RTN","PRCHLO2A",47,0) ; "RTN","PRCHLO2A",48,0) Q "RTN","PRCHLO2A",49,0) LPPOPTR ; Loop on Prompt Payment Terms "RTN","PRCHLO2A",50,0) S PPO=0 "RTN","PRCHLO2A",51,0) F S PPO=$O(^PRC(442,POID,5,PPO)) Q:PPO="" D "RTN","PRCHLO2A",52,0) . S PPOVAL=$G(^PRC(442,POID,5,PPO,0)) "RTN","PRCHLO2A",53,0) . S PP1=$P(PPOVAL,U,1),PP2=$P(PPOVAL,U,2),PP3=$P(PPOVAL,U,3) "RTN","PRCHLO2A",54,0) . S PP4=$P(PPOVAL,U,4) "RTN","PRCHLO2A",55,0) . S PPOVAL1=PP1_U_PP2_U_PP3_U_PP4 "RTN","PRCHLO2A",56,0) . ; add key to data "RTN","PRCHLO2A",57,0) . I PPOVAL'="" S ^TMP($J,"POPROMPT",POID,PPO,0)=PPOKEY_U_PPO_U_PPOVAL1 "RTN","PRCHLO2A",58,0) . Q "RTN","PRCHLO2A",59,0) Q "RTN","PRCHLO2A",60,0) LPPOOB ; Loop on PO Obligation "RTN","PRCHLO2A",61,0) N X "RTN","PRCHLO2A",62,0) I CKOB1>0 D "RTN","PRCHLO2A",63,0) . S PPO=0 "RTN","PRCHLO2A",64,0) . F S PPO=$O(^PRC(442,POID,10,PPO)) Q:PPO="" D "RTN","PRCHLO2A",65,0) . . S PPOVAL=$G(^PRC(442,POID,10,PPO,0)) "RTN","PRCHLO2A",66,0) . . S PP1=$P(PPOVAL,U,1),PP2=$P(PPOVAL,U,2),PP3=$P(PPOVAL,U,3) "RTN","PRCHLO2A",67,0) . . ; get external for PP2, Obligated by "RTN","PRCHLO2A",68,0) . . I PP2'="" S PP2E1=$G(^VA(200,+PP2,0)),PP2E2=$P(PP2E1,U,1) "RTN","PRCHLO2A",69,0) . . I PP2="" S PP2E2="" "RTN","PRCHLO2A",70,0) . . S PP4=$P(PPOVAL,U,10),PP5=$P(PPOVAL,U,11) "RTN","PRCHLO2A",71,0) . . I PP5'="" S PP5E1=$G(^PRCS(410,+PP5,0)),PP5E2=$P(PP5E1,U,1) "RTN","PRCHLO2A",72,0) . . I PP5="" S PP5E2="" "RTN","PRCHLO2A",73,0) . . I PP1'="" S PP1A=$P(PP1,".",5),PP1=$P(PP1A,"@",1) "RTN","PRCHLO2A",74,0) . . S PPALL=PP1_U_PP2E2_U_PP3_U_PP4_U_PP5E2 "RTN","PRCHLO2A",75,0) . . S PPALL=PPALL_U_PP2 ;DUZ Obligated By "RTN","PRCHLO2A",76,0) . . S PPALL=PPALL_U_PP5 ;IEN 1358 Adjustment "RTN","PRCHLO2A",77,0) . . S X=$P(PPOVAL,U,6) S:X'="" X=$$FMTE^XLFDT($P(X,".")) "RTN","PRCHLO2A",78,0) . . S PPALL=PPALL_U_X ;Date Signed "RTN","PRCHLO2A",79,0) . . S X=$P(PPOVAL,U,12) S:X'="" X=$$FMTE^XLFDT(X) "RTN","PRCHLO2A",80,0) . . S PPALL=PPALL_U_X ;Obligation Process Date "RTN","PRCHLO2A",81,0) . . S X=$P(PPOVAL,U,13) S:X'="" X=$P("JAN;FEB;MAR;APR;MAY;JUN;JUL;AUG;SEP;OCT;NOV;DEC",";",+$E(X,4,5))_" "_(1700+$E(X,1,3)) "RTN","PRCHLO2A",82,0) . . S PPALL=PPALL_U_X ;Accounting Period "RTN","PRCHLO2A",83,0) . . ; "RTN","PRCHLO2A",84,0) . . S PP2=$P($G(^VA(200,+PP2,5)),U) "RTN","PRCHLO2A",85,0) . . S PP3=$S(PP2="":"",1:$$GET1^DIQ(49,+PP2_",",.01)) "RTN","PRCHLO2A",86,0) . . S PPALL=PPALL_U_PP2_U_PP3 ;OBL BY SERVICE INT/EXT "RTN","PRCHLO2A",87,0) . . ; "RTN","PRCHLO2A",88,0) . . S ^TMP($J,"POOBLG",POID,PPO)=PPOKEY_U_PPO_U_PPALL "RTN","PRCHLO2A",89,0) . . Q "RTN","PRCHLO2A",90,0) . Q "RTN","PRCHLO2A",91,0) Q "RTN","PRCHLO2A",92,0) LPPM ; Loop PoPoPurchaseMethod Table "RTN","PRCHLO2A",93,0) F S PPO=$O(^PRC(442,POID,14,PPO)) Q:PPO="" D "RTN","PRCHLO2A",94,0) . Q:PPO="B" ; don't want B index "RTN","PRCHLO2A",95,0) . S PPOVAL=$G(^PRC(442,POID,14,PPO,0)) "RTN","PRCHLO2A",96,0) . ; "RTN","PRCHLO2A",97,0) . S PPOVAL1=$P(PPOVAL,U,1) "RTN","PRCHLO2A",98,0) . ; Get external value of PPOVAL1 "RTN","PRCHLO2A",99,0) . I PPOVAL1'="" S PPOVAL1E=$G(^PRC(442.4,+PPOVAL1,0)),PPOVAL2E=$P(PPOVAL1E,U,3) "RTN","PRCHLO2A",100,0) . I PPOVAL1="" S PPOVAL2E="" "RTN","PRCHLO2A",101,0) . S PPOVAL2=PPOKEY_U_PPO_U_PPOVAL2E "RTN","PRCHLO2A",102,0) . S ^TMP($J,"POPMETH",POID,PPO)=PPOVAL2 "RTN","PRCHLO2A",103,0) . Q "RTN","PRCHLO2A",104,0) Q "RTN","PRCHLO2A",105,0) ; "RTN","PRCHLO2A",106,0) LPPART ; Loop on Partial "RTN","PRCHLO2A",107,0) N PPOVAL,PPV1,PPV2,PPV3,PPV4,PPV5,PPV6,PPV7,PPVALL,POKEY,PPOVAL2 "RTN","PRCHLO2A",108,0) N PPOVAL1,PPV8,PPV9,PPV10,PPV11,PPV12,PPV13,PPVALL1 "RTN","PRCHLO2A",109,0) N PPV3E1,PPV3E2,PPV5E1,PPV5E2,PPV1E,PPV1E1,PPV2E,PPV2E1 "RTN","PRCHLO2A",110,0) F S PPO=$O(^PRC(442,POID,11,PPO)) Q:PPO="" D "RTN","PRCHLO2A",111,0) . S PPOVAL=$G(^PRC(442,POID,11,PPO,0)) "RTN","PRCHLO2A",112,0) . S PPOVAL1=$G(^PRC(442,POID,11,PPO,1)) "RTN","PRCHLO2A",113,0) . S PPV1=$P(PPOVAL,U,1),PPV2=$P(PPOVAL1,U,8),PPV3=$P(PPOVAL,U,2) "RTN","PRCHLO2A",114,0) . ; get external date value for Date "RTN","PRCHLO2A",115,0) . I PPV1'="" S PPV1E=$P(PPV1,".",1),PPV1E1=$$FMTE^XLFDT(PPV1E) "RTN","PRCHLO2A",116,0) . I PPV1="" S PPV1E1="" "RTN","PRCHLO2A",117,0) . ; get external date value for Scheduled delivery date "RTN","PRCHLO2A",118,0) . I PPV2'="" S PPV2E=$P(PPV2,".",1),PPV2E1=$$FMTE^XLFDT(PPV2E) "RTN","PRCHLO2A",119,0) . I PPV2="" S PPV2E1="" "RTN","PRCHLO2A",120,0) . ; get external value for PPV3 "RTN","PRCHLO2A",121,0) . I PPV3'="" S PPV3E1=$G(^PRCD(420.2,+PPV3,0)),PPV3E2=$P(PPV3E1,U,1) "RTN","PRCHLO2A",122,0) . I PPV3="" S PPV3E2="" "RTN","PRCHLO2A",123,0) . S PPV4=$P(PPOVAL,U,3),PPV5=$P(PPOVAL,U,4),PPV6=$P(PPOVAL,U,5) "RTN","PRCHLO2A",124,0) . ; get external value for PPV5 "RTN","PRCHLO2A",125,0) . I PPV5'="" S PPV5E1=$G(^PRCD(420.2,+PPV5,0)),PPV5E2=$P(PPV5E1,U,1) "RTN","PRCHLO2A",126,0) . I PPV5="" S PPV5E2="" "RTN","PRCHLO2A",127,0) . S PPV7=$P(PPOVAL,U,9),PPV8=$P(PPOVAL,U,10),PPV9=$P(PPOVAL,U,12) "RTN","PRCHLO2A",128,0) . S PPV10=$P(PPOVAL,U,13),PPV11=$P(PPOVAL,U,14),PPV12=$P(PPOVAL1,U,16) "RTN","PRCHLO2A",129,0) . S PPV13=$P(PPOVAL,U,21) "RTN","PRCHLO2A",130,0) . S PPVALL=PPV1E1_U_PPV2E1_U_PPV3E2_U_PPV4_U_PPV5E2_U_PPV6_U_PPV7 "RTN","PRCHLO2A",131,0) . S PPVALL1=PPVALL_U_PPV8_U_PPV9_U_PPV10_U_PPV11_U_PPV12_U_PPV13 "RTN","PRCHLO2A",132,0) . ; "RTN","PRCHLO2A",133,0) . S PPOVAL2=PPOKEY_U_PPO_U_PPVALL1 "RTN","PRCHLO2A",134,0) . S ^TMP($J,"POPART",POID,PPO)=PPOVAL2 "RTN","PRCHLO2A",135,0) . Q "RTN","PRCHLO2A",136,0) Q "RTN","PRCHLO3") 0^8^B150252555^B56712862 "RTN","PRCHLO3",1,0) PRCHLO3 ;WOIFO/RLL-EXTRACT ROUTINE CLO REPORT SERVER ;5/22/09 14:13 "RTN","PRCHLO3",2,0) ;;5.1;IFCAP;**83,130**;Oct 20, 2000;Build 25 "RTN","PRCHLO3",3,0) ;Per VHA Directive 2004-038, this routine should not be modified. "RTN","PRCHLO3",4,0) ; Continuation of PRCHLO2 "RTN","PRCHLO3",5,0) ; "RTN","PRCHLO3",6,0) ; PRCHLO3 routines are used to Write out the Header and data "RTN","PRCHLO3",7,0) ; associated with each of the 23 tables created for the Clinical "RTN","PRCHLO3",8,0) ; logistics Report Server. The files are built from the extracts "RTN","PRCHLO3",9,0) ; located in the ^TMP($J) global. "RTN","PRCHLO3",10,0) ; "RTN","PRCHLO3",11,0) Q "RTN","PRCHLO3",12,0) POMASTH ; Po Master Table Header file "RTN","PRCHLO3",13,0) W "PoIdNum^PurchaseOrderNum^PoDate^MonthYrRun^StationNum^Primary2237" "RTN","PRCHLO3",14,0) W "^MethodOfProcessing^LocalProcReasonCode^ExpendableNonExpendable" "RTN","PRCHLO3",15,0) W "^SupplyStatus^SupplyStatusOrder^FiscalStatusOrder^FCP" "RTN","PRCHLO3",16,0) W "^Appropriation^CostCenter^SubAccount1^SubAmount1^SubAccount2" "RTN","PRCHLO3",17,0) W "^SubAmount2^IENprimary2237^IENmethodOfProcessing^IENsupplyStatus" "RTN","PRCHLO3",18,0) W "^IENsubaccount1^IENsubaccount2^Vendor^RequestingService^FobPoint" "RTN","PRCHLO3",19,0) W "^OriginalDeliveryDate^EstCost^SourceCode^EstShipping" "RTN","PRCHLO3",20,0) W "^ShippingLineItemNum^LineItemCount^PaPpmAuthBuyer" "RTN","PRCHLO3",21,0) W "^AgentAssignedPo^DatePoAssigned^Remarks^OldPoRecord^NewPoRecord" "RTN","PRCHLO3",22,0) W "^PaPpmAuthBuyerSVCint^PaPpmAuthBuyerSVCext" "RTN","PRCHLO3",23,0) W "^AgentAssignedDuz^AgentAssignedSVCint^AgentAssignedSVCext" "RTN","PRCHLO3",24,0) W "^PcdoVendor^PurchaseCardUser^PurchaseCost^PurchaseCardHolder" "RTN","PRCHLO3",25,0) W "^Pcdo2237^TotalAmount^NetAmount" "RTN","PRCHLO3",26,0) W "^PurchaseCardUserSVCint^PurchaseCardUserSVCext" "RTN","PRCHLO3",27,0) W "^PurchaseCardHolderSVCint^PurchaseCardHolderSVCext^BBFY" "RTN","PRCHLO3",28,0) W "^EndDateForServiceOrder^AutoAccrue^SubstationIEN^SubstationExternal" "RTN","PRCHLO3",29,0) W "^VendorIEN^VendorFMSCode^VendorAlt-Addr-Ind^VendorDandB" "RTN","PRCHLO3",30,0) W "^Month^Quarter^LastDigitFicalYear^Actual1358Balance" "RTN","PRCHLO3",31,0) W "^Fiscal1358Balance^Est1358Balance^BulletinSent^InterfacePkgPrefix" "RTN","PRCHLO3",32,0) W "^DocumentID/CommonNumber^DoYouWantToSendThisEDI" "RTN","PRCHLO3",33,0) W "^ReasonNotCompeted^NumberOfOffers^PreAwardSynopsis" "RTN","PRCHLO3",34,0) W "^AlternativeAdvertising^SolicitationProcedure^EvaluatedPreference" "RTN","PRCHLO3",35,0) W "^FundingAgencyCode^FundingAgencyOfficeCode^MultiYear" "RTN","PRCHLO3",36,0) W "^EPADesignatedProduct^ContractBundling^ExtentCompeted" "RTN","PRCHLO3",37,0) W "^Perf.BasedServiceContract^ClingerCohen^PlaceOfPerfThisStation" "RTN","PRCHLO3",38,0) W "^PlaceOfPerformance^SendtoFPDS^DuzPABuyer^DuzPCUser^DuzPCHolder" "RTN","PRCHLO3",39,0) W "^RegionalACQcenter",! "RTN","PRCHLO3",40,0) Q "RTN","PRCHLO3",41,0) POMASTW ; Write PO Master table data "RTN","PRCHLO3",42,0) N GPOID,GPOND "RTN","PRCHLO3",43,0) S GPOID=0,GPOND="" "RTN","PRCHLO3",44,0) F S GPOID=$O(^TMP($J,"POMAST",GPOID)) Q:GPOID="" D "RTN","PRCHLO3",45,0) . ; W ! ; new line for each PO "RTN","PRCHLO3",46,0) . F S GPOND=$O(^TMP($J,"POMAST",GPOID,GPOND)) Q:GPOND="" D "RTN","PRCHLO3",47,0) . . W $G(^TMP($J,"POMAST",GPOID,GPOND)) "RTN","PRCHLO3",48,0) . . Q "RTN","PRCHLO3",49,0) . W ! ; new line for each PO "RTN","PRCHLO3",50,0) . Q "RTN","PRCHLO3",51,0) Q "RTN","PRCHLO3",52,0) ; "RTN","PRCHLO3",53,0) POOBHD ; PO Obligation Header "RTN","PRCHLO3",54,0) ; "RTN","PRCHLO3",55,0) W "PoIdNum^PurchaseOrderNum^PoDate^MonthYrRun^StationNum^" "RTN","PRCHLO3",56,0) W "ObDataIdNum^Tdateref^ObligatedBy^TransactionAmount^" "RTN","PRCHLO3",57,0) W "AmendmentNumber^Z1358Adjustment^DUZObligatedBy^IEN1358Adjustment^" "RTN","PRCHLO3",58,0) W "DateSigned^ObligationProcessDate^" "RTN","PRCHLO3",59,0) W "AccountingPeriod^ObligatedBySVCint^ObligatedBySVCext",! "RTN","PRCHLO3",60,0) Q "RTN","PRCHLO3",61,0) ; "RTN","PRCHLO3",62,0) POOBW ; Write PO Obligation data "RTN","PRCHLO3",63,0) N POOBID,POOBID1 "RTN","PRCHLO3",64,0) S POOBID=0,POOBID1=0 "RTN","PRCHLO3",65,0) F S POOBID=$O(^TMP($J,"POOBLG",POOBID)) Q:POOBID="" D "RTN","PRCHLO3",66,0) . F S POOBID1=$O(^TMP($J,"POOBLG",POOBID,POOBID1)) Q:POOBID1="" D "RTN","PRCHLO3",67,0) . . W $G(^TMP($J,"POOBLG",POOBID,POOBID1)),! "RTN","PRCHLO3",68,0) . . Q "RTN","PRCHLO3",69,0) . Q "RTN","PRCHLO3",70,0) Q "RTN","PRCHLO3",71,0) POPMEH ; Purchase Order Purchase Method Header "RTN","PRCHLO3",72,0) W "PoIdNum^PurchaseOrderNum^PoDate^MonthYrRun^StationNum^" "RTN","PRCHLO3",73,0) W "PurchaseMethodIdNum^PurchaseMethod",! "RTN","PRCHLO3",74,0) Q "RTN","PRCHLO3",75,0) POPMEW ; Write Purchase Order Purchase Method Data "RTN","PRCHLO3",76,0) N POMT1,POMT2 "RTN","PRCHLO3",77,0) S POMT1=0,POMT2=0 "RTN","PRCHLO3",78,0) F S POMT1=$O(^TMP($J,"POPMETH",POMT1)) Q:POMT1="" D "RTN","PRCHLO3",79,0) . F S POMT2=$O(^TMP($J,"POPMETH",POMT1,POMT2)) Q:POMT2="" D "RTN","PRCHLO3",80,0) . . W $G(^TMP($J,"POPMETH",POMT1,POMT2)),! "RTN","PRCHLO3",81,0) . .Q "RTN","PRCHLO3",82,0) . Q "RTN","PRCHLO3",83,0) Q "RTN","PRCHLO3",84,0) ; "RTN","PRCHLO3",85,0) POPART ; PO Partial Header "RTN","PRCHLO3",86,0) W "PoIdNum^PurchaseOrderNum^PoDate^MonthYrRun^StationNum^" "RTN","PRCHLO3",87,0) W "PartialIdNum^Date^ScheduledDeliveryDate^SubAccount1^Subamount1^" "RTN","PRCHLO3",88,0) W "SubAccount2^SubAmount2^Final^Overage^TotalAmount^" "RTN","PRCHLO3",89,0) W "DiscountPercentDays^Linecount^OriginalPartial^" "RTN","PRCHLO3",90,0) W "AdjustmentAmendmentNumber",! "RTN","PRCHLO3",91,0) Q "RTN","PRCHLO3",92,0) POPARTW ; PO Partial Data Write "RTN","PRCHLO3",93,0) N POPR1,POPR2 "RTN","PRCHLO3",94,0) S POPR1=0,POPR2=0 "RTN","PRCHLO3",95,0) F S POPR1=$O(^TMP($J,"POPART",POPR1)) Q:POPR1="" D "RTN","PRCHLO3",96,0) . F S POPR2=$O(^TMP($J,"POPART",POPR1,POPR2)) Q:POPR2="" D "RTN","PRCHLO3",97,0) . . W $G(^TMP($J,"POPART",POPR1,POPR2)),! "RTN","PRCHLO3",98,0) . . Q "RTN","PRCHLO3",99,0) . Q "RTN","PRCHLO3",100,0) Q "RTN","PRCHLO3",101,0) ; "RTN","PRCHLO3",102,0) PO2237H ; Po 2237 Header "RTN","PRCHLO3",103,0) W "PoIdNum^PurchaseOrderNum^PoDate^MonthYrRun^StationNum^" "RTN","PRCHLO3",104,0) W "Z2237IdNum^Z2237RefNum^AccountableOfficer^DateSigned^" "RTN","PRCHLO3",105,0) W "PurchasingAgent^TypeOfRequest^SourceOfRequest^InvDistPoint^" "RTN","PRCHLO3",106,0) W "DuzPA^DuzAccountableOfficer^PASVCint^PASVCext^" "RTN","PRCHLO3",107,0) W "AccountableOfficeSVCint^AccountableOfficeSVCext",! "RTN","PRCHLO3",108,0) Q "RTN","PRCHLO3",109,0) ; "RTN","PRCHLO3",110,0) PO2237W ; PO 2237 Write Data "RTN","PRCHLO3",111,0) N PO37A,PO37B "RTN","PRCHLO3",112,0) S PO37A=0,PO37B=0 "RTN","PRCHLO3",113,0) F S PO37A=$O(^TMP($J,"PO2237",PO37A)) Q:PO37A="" D "RTN","PRCHLO3",114,0) . F S PO37B=$O(^TMP($J,"PO2237",PO37A,PO37B)) Q:PO37B="" D "RTN","PRCHLO3",115,0) . . W $G(^TMP($J,"PO2237",PO37A,PO37B)),! "RTN","PRCHLO3",116,0) . . Q "RTN","PRCHLO3",117,0) . Q "RTN","PRCHLO3",118,0) Q "RTN","PRCHLO3",119,0) POBOCH ; PO BOC Header "RTN","PRCHLO3",120,0) W "PoIdNum^PurchaseOrderNum^PoDate^MonthYrRun^StationNum^" "RTN","PRCHLO3",121,0) W "BocIdNum^Subaccount^SubAmount^FMSline",! "RTN","PRCHLO3",122,0) Q "RTN","PRCHLO3",123,0) POBOCW ; PO BOC Write Data "RTN","PRCHLO3",124,0) N POBOC,POBOC1 "RTN","PRCHLO3",125,0) S POBOC=0,POBOC1=0 "RTN","PRCHLO3",126,0) F S POBOC=$O(^TMP($J,"POBOC",POBOC)) Q:POBOC="" D "RTN","PRCHLO3",127,0) . F S POBOC1=$O(^TMP($J,"POBOC",POBOC,POBOC1)) Q:POBOC1="" D "RTN","PRCHLO3",128,0) . . W $G(^TMP($J,"POBOC",POBOC,POBOC1)),! "RTN","PRCHLO3",129,0) . . Q "RTN","PRCHLO3",130,0) . Q "RTN","PRCHLO3",131,0) Q "RTN","PRCHLO3",132,0) POCMTSH ;PO Comments Header "RTN","PRCHLO3",133,0) W "PoIdNum^PurchaseOrderNum^PoDate^MonthYrRun^StationNum^" "RTN","PRCHLO3",134,0) W "CommentsIdNum^Comments",! "RTN","PRCHLO3",135,0) Q "RTN","PRCHLO3",136,0) POCMTSW ; PO Comments Write Data "RTN","PRCHLO3",137,0) N POCMT,POCMT1 "RTN","PRCHLO3",138,0) S POCMT=0,POCMT1=0 "RTN","PRCHLO3",139,0) F S POCMT=$O(^TMP($J,"POCOMMENTS",POCMT)) Q:POCMT="" D "RTN","PRCHLO3",140,0) . W $G(^TMP($J,"POCOMMENTS",POCMT)),! "RTN","PRCHLO3",141,0) . Q "RTN","PRCHLO3",142,0) Q "RTN","PRCHLO3",143,0) PORMKH ; PO Remarks Header "RTN","PRCHLO3",144,0) W "PoIdNum^PurchaseOrderNum^PoDate^MonthYrRun^StationNum^" "RTN","PRCHLO3",145,0) W "RemarksIdNum^Remarks",! "RTN","PRCHLO3",146,0) Q "RTN","PRCHLO3",147,0) PORMKW ; PO Remarks Write Data "RTN","PRCHLO3",148,0) N PORMK "RTN","PRCHLO3",149,0) S PORMK=0 "RTN","PRCHLO3",150,0) F S PORMK=$O(^TMP($J,"POREMARKS",PORMK)) Q:PORMK="" D "RTN","PRCHLO3",151,0) . W $G(^TMP($J,"POREMARKS",PORMK)),! "RTN","PRCHLO3",152,0) . Q "RTN","PRCHLO3",153,0) Q "RTN","PRCHLO3",154,0) POPPTH ; Prompt Payment Terms Header "RTN","PRCHLO3",155,0) W "PoIdNum^PurchaseOrderNum^PoDate^MonthYrRun^StationNum^" "RTN","PRCHLO3",156,0) W "PaymentTermsIdNum^PromptPaymentPercent^DaysTerm^Contract^Astr",! "RTN","PRCHLO3",157,0) Q "RTN","PRCHLO3",158,0) POPPTW ; Prompt Payment Terms Write Data "RTN","PRCHLO3",159,0) N POPPT,POPPT1 "RTN","PRCHLO3",160,0) S POPPT=0,POPPT1=0 "RTN","PRCHLO3",161,0) F S POPPT=$O(^TMP($J,"POPROMPT",POPPT)) Q:POPPT="" D "RTN","PRCHLO3",162,0) . F S POPPT1=$O(^TMP($J,"POPROMPT",POPPT,POPPT1)) Q:POPPT1="" D "RTN","PRCHLO3",163,0) . . W $G(^TMP($J,"POPROMPT",POPPT,POPPT1,0)),! "RTN","PRCHLO3",164,0) . . Q "RTN","PRCHLO3",165,0) . Q "RTN","PRCHLO3",166,0) Q "RTN","PRCHLO3",167,0) POAMTH ; PO Amount Header "RTN","PRCHLO3",168,0) W "PoIdNum^PurchaseOrderNum^PoDate^MonthYrRun^StationNum^" "RTN","PRCHLO3",169,0) W "AmountIdNum^Amount^TypeCode^CompStatusBusiness^PrefProgram^" "RTN","PRCHLO3",170,0) W "Contract",! "RTN","PRCHLO3",171,0) Q "RTN","PRCHLO3",172,0) POAMTW ; PO Amount Write Data "RTN","PRCHLO3",173,0) N POAMT,POAMT1,POAMT2 "RTN","PRCHLO3",174,0) S POAMT=0,POAMT1=0 "RTN","PRCHLO3",175,0) F S POAMT=$O(^TMP($J,"POAMT",POAMT)) Q:POAMT="" D "RTN","PRCHLO3",176,0) . F S POAMT1=$O(^TMP($J,"POAMT",POAMT,POAMT1)) Q:POAMT1="" D "RTN","PRCHLO3",177,0) . . W $G(^TMP($J,"POAMT",POAMT,POAMT1,0)),! "RTN","PRCHLO3",178,0) . . Q "RTN","PRCHLO3",179,0) . Q "RTN","PRCHLO3",180,0) Q "RTN","PRCHLO3",181,0) PAMTBKH ; PO Amount Breakout Code Header "RTN","PRCHLO3",182,0) W "PoIdNum^PurchaseOrderNum^PoDate^MonthYrRun^StationNum^" "RTN","PRCHLO3",183,0) W "AmountIdNum^AmountBrkCodeIdNum^BreakoutCode",! "RTN","PRCHLO3",184,0) Q "RTN","PRCHLO3",185,0) POAMDH ; PO Amendment Header "RTN","PRCHLO3",186,0) W "PoIdNum^PurchaseOrderNum^PoDate^MonthYrRun^StationNum^" "RTN","PRCHLO3",187,0) W "AmendmentIdNum^Amendment^EffectiveDate^AmountChanged^" "RTN","PRCHLO3",188,0) W "PappmAuthBuyer^AmendmentAdjStatus^" "RTN","PRCHLO3",189,0) W "DuzPappmAuthBuyer^DuzFiscalApprover^NameFiscalApprover^" "RTN","PRCHLO3",190,0) W "PappmAuthBuyerSVCint^PappmAuthBuyerSVCext^" "RTN","PRCHLO3",191,0) W "FiscalApproverSVCint^FiscalApproverSVCext",! "RTN","PRCHLO3",192,0) Q "RTN","PRCHLO3",193,0) POAMDW ; PO Amendment Write Data "RTN","PRCHLO3",194,0) N POAMD,POAMD1,POAMD2 "RTN","PRCHLO3",195,0) S POAMD=0,POAMD1=0 "RTN","PRCHLO3",196,0) F S POAMD=$O(^TMP($J,"POAMMD",POAMD)) Q:POAMD="" D "RTN","PRCHLO3",197,0) . F S POAMD1=$O(^TMP($J,"POAMMD",POAMD,POAMD1)) Q:POAMD1="" D "RTN","PRCHLO3",198,0) . . W $G(^TMP($J,"POAMMD",POAMD,POAMD1,0)),! "RTN","PRCHLO3",199,0) . . Q "RTN","PRCHLO3",200,0) . Q "RTN","PRCHLO3",201,0) Q "RTN","PRCHLO3",202,0) ; "RTN","PRCHLO3",203,0) POAMDCH ; PO Amendment Changes Header "RTN","PRCHLO3",204,0) W "PoIdNum^PurchaseOrderNum^PoDate^MonthYrRun^StationNum^" "RTN","PRCHLO3",205,0) W "AmendmentIdNum^AmendmentChangeIdNum^Changes^AmendmentType",! "RTN","PRCHLO3",206,0) Q "RTN","PRCHLO3",207,0) POAMDCW ; PO Amendment Changes Write Data "RTN","PRCHLO3",208,0) N PAMDC,PAMDC1,PAMDC2,PAMDC3,PAMDC4 "RTN","PRCHLO3",209,0) S PAMDC=0,PAMDC1=0,PAMDC2=0,PAMDC3=0 "RTN","PRCHLO3",210,0) F S PAMDC=$O(^TMP($J,"POAMMDCH",PAMDC)) Q:PAMDC="" D "RTN","PRCHLO3",211,0) . F S PAMDC1=$O(^TMP($J,"POAMMDCH",PAMDC,PAMDC1)) Q:PAMDC1="" D "RTN","PRCHLO3",212,0) . . F S PAMDC2=$O(^TMP($J,"POAMMDCH",PAMDC,PAMDC1,PAMDC2)) Q:PAMDC2="" D "RTN","PRCHLO3",213,0) . . . W $G(^TMP($J,"POAMMDCH",PAMDC,PAMDC1,PAMDC2,0)),! "RTN","PRCHLO3",214,0) . . . Q "RTN","PRCHLO3",215,0) . . Q "RTN","PRCHLO3",216,0) . Q "RTN","PRCHLO3",217,0) Q "RTN","PRCHLO3",218,0) PAMDDH ; PO Amendment Description Header "RTN","PRCHLO3",219,0) W "PoIdNum^PurchaseOrderNum^PoDate^MonthYrRun^StationNum^" "RTN","PRCHLO3",220,0) W "AmendmentIdNum^AmendmentDescIdNum^Description",! "RTN","PRCHLO3",221,0) Q "RTN","PRCHLO3",222,0) ; "RTN","PRCHLO3",223,0) PAMDDW ; PO Amendment Description Write Data "RTN","PRCHLO3",224,0) N PAMD,PAMD1,PAMD2,PAMD3 "RTN","PRCHLO3",225,0) S PAMD=0,PAMD1=0,PAMD2=0 "RTN","PRCHLO3",226,0) F S PAMD=$O(^TMP($J,"POAMMDDES",PAMD)) Q:PAMD="" D "RTN","PRCHLO3",227,0) . F S PAMD1=$O(^TMP($J,"POAMMDDES",PAMD,PAMD1)) Q:PAMD1="" D "RTN","PRCHLO3",228,0) . . F S PAMD2=$O(^TMP($J,"POAMMDDES",PAMD,PAMD1,PAMD2)) Q:PAMD2="" D "RTN","PRCHLO3",229,0) . . . W $G(^TMP($J,"POAMMDDES",PAMD,PAMD1,PAMD2,0)),! "RTN","PRCHLO3",230,0) . . . Q "RTN","PRCHLO3",231,0) . . Q "RTN","PRCHLO3",232,0) . Q "RTN","PRCHLO3",233,0) Q "RTN","PRCHLO3",234,0) PAMTBKW ; Write Breakout Code data "RTN","PRCHLO3",235,0) N BCD,BCD1,BCD2,BCD3 "RTN","PRCHLO3",236,0) S BCD=0,BCD1=0,BCD2=0 "RTN","PRCHLO3",237,0) F S BCD=$O(^TMP($J,"POBKCOD",BCD)) Q:BCD="" D "RTN","PRCHLO3",238,0) . F S BCD1=$O(^TMP($J,"POBKCOD",BCD,BCD1)) Q:BCD1="" D "RTN","PRCHLO3",239,0) . . F S BCD2=$O(^TMP($J,"POBKCOD",BCD,BCD1,BCD2)) Q:BCD2="" D "RTN","PRCHLO3",240,0) . . . ; "RTN","PRCHLO3",241,0) . . . W $G(^TMP($J,"POBKCOD",BCD,BCD1,BCD2,0)),! "RTN","PRCHLO3",242,0) . . Q "RTN","PRCHLO3",243,0) . Q "RTN","PRCHLO3",244,0) Q "RTN","PRCHLO3",245,0) CONTRPH ; Write File 410 header (Control Point Activities) "RTN","PRCHLO3",246,0) W "TransactionNumber^TransactionIEN^StationNumber^MonthYrRun^TransactionType^FormType^" "RTN","PRCHLO3",247,0) W "SubStationIEN^SubStationEXT^RunningBalQuarterDate^RunningBalStatus^" "RTN","PRCHLO3",248,0) W "DateOfRequest^ClassOfRequestIEN^ClassOfRequestEXT^Vendor^" "RTN","PRCHLO3",249,0) W "VendorAddress1^VendorAddress2^VendorAddress3^VendorAddress4^" "RTN","PRCHLO3",250,0) W "VendorCity^VendorState^VendorZIPcode^VendorContact^VendorPhone^" "RTN","PRCHLO3",251,0) W "VendorIEN^VendorName^VendorFMSCode^VendorAlt-Addr-Ind^" "RTN","PRCHLO3",252,0) W "VendorDandB^VendorContractNumber^ControlPoint^CostCenter^" "RTN","PRCHLO3",253,0) W "BOC1^BOC1Amount^AccountingData^FcpPrj^BBFY^" "RTN","PRCHLO3",254,0) W "CommittedCost^DateCommitted^ObligatedActualCost^" "RTN","PRCHLO3",255,0) W "DateObligated^PurchaseOrderObligationNumber^AdjustmentAmount^" "RTN","PRCHLO3",256,0) W "DateOBLAjusted^TransactionAmount^" "RTN","PRCHLO3",257,0) W "ObligatedByDUZ^ObligatedByName^ObligatedBySVCint^" "RTN","PRCHLO3",258,0) W "ObligatedBySVCext^ObligationValCodeDateTime^" "RTN","PRCHLO3",259,0) W "RequestorDUZ^RequestorName^RequestorSVCint^RequestorSVCext^" "RTN","PRCHLO3",260,0) W "RequestorTitle^ApprovOfficialDUZ^ApprovOfficialName^" "RTN","PRCHLO3",261,0) W "ApprovOfficialSVCint^ApprovOfficialSVCext^ApprovOfficialTitle^" "RTN","PRCHLO3",262,0) W "DateSigned^ESCodeDateTime^" "RTN","PRCHLO3",263,0) W "Justification^SortGroup^StationPONoIEN^StationPONoEXT^PoDate^Status^" "RTN","PRCHLO3",264,0) W "Comments^ReasonForReturn",! "RTN","PRCHLO3",265,0) Q "RTN","PRCHLO3",266,0) CONTRPW ; Write File 410 data (Control Point Activities) "RTN","PRCHLO3",267,0) N GPOID,GPOND "RTN","PRCHLO3",268,0) S GPOID=0,GPOND="" "RTN","PRCHLO3",269,0) F S GPOID=$O(^TMP($J,"CONTRP",GPOID)) Q:GPOID="" D "RTN","PRCHLO3",270,0) . F S GPOND=$O(^TMP($J,"CONTRP",GPOID,GPOND)) Q:GPOND="" D "RTN","PRCHLO3",271,0) . . W $G(^TMP($J,"CONTRP",GPOID,GPOND)) "RTN","PRCHLO3",272,0) . . Q "RTN","PRCHLO3",273,0) . W ! ; new line for each file #410 entry "RTN","PRCHLO3",274,0) . Q "RTN","PRCHLO3",275,0) Q "RTN","PRCHLO3",276,0) SUBCPH ; Write File 410.04 header (Sub Control Point) "RTN","PRCHLO3",277,0) W "TransactionNumber^TransactionIEN^StationNumber^StationPONoIEN^StationPONoEXT^PoDate^MonthYrRun^SubControlPoint^Amount^SCPAMT",! "RTN","PRCHLO3",278,0) Q "RTN","PRCHLO3",279,0) SUBCPW ; Write File 410.04 data (Sub Control Point) "RTN","PRCHLO3",280,0) N GPOID,GPOND "RTN","PRCHLO3",281,0) S GPOID=0,GPOND="" "RTN","PRCHLO3",282,0) F S GPOID=$O(^TMP($J,"SUBCP",GPOID)) Q:GPOID="" D "RTN","PRCHLO3",283,0) . F S GPOND=$O(^TMP($J,"SUBCP",GPOID,GPOND)) Q:GPOND="" D "RTN","PRCHLO3",284,0) . . W $G(^TMP($J,"SUBCP",GPOID,GPOND)),! "RTN","PRCHLO3",285,0) . . Q "RTN","PRCHLO3",286,0) . Q "RTN","PRCHLO3",287,0) Q "RTN","PRCHLO3",288,0) DR1358H ; Write File 424 header (1358 Daily Record) "RTN","PRCHLO3",289,0) W "PoIdNum^PurchaseOrderNum^PoDate^MonthYrRun^StationNum^AuthorizationNumber^TransactionType^" "RTN","PRCHLO3",290,0) W "LiquidationAmount^AuthBalance^ObligationAmount^DateTime^UserDUZ^" "RTN","PRCHLO3",291,0) W "UserName^UserSVCint^UserSVCext^CompletedFlag^Reference^" "RTN","PRCHLO3",292,0) W "LastSequenceUsed^AuthAmount^" "RTN","PRCHLO3",293,0) W "OriginalAuthAmount^LastEditByDUZ^LastEditByName^LastEditBySVCint^" "RTN","PRCHLO3",294,0) W "LastEditBySVCext^CPApointerIEN^CPApointerEXT^Comments^InterfaceID",! "RTN","PRCHLO3",295,0) Q "RTN","PRCHLO3",296,0) DR1358W ; Write File 424 data (1358 Daily Record) "RTN","PRCHLO3",297,0) N GPOID,GPOND "RTN","PRCHLO3",298,0) S GPOID=0,GPOND="" "RTN","PRCHLO3",299,0) F S GPOID=$O(^TMP($J,"DR1358",GPOID)) Q:GPOID="" D "RTN","PRCHLO3",300,0) . F S GPOND=$O(^TMP($J,"DR1358",GPOID,GPOND)) Q:GPOND="" D "RTN","PRCHLO3",301,0) . . W $G(^TMP($J,"DR1358",GPOID,GPOND)),! "RTN","PRCHLO3",302,0) . . Q "RTN","PRCHLO3",303,0) . Q "RTN","PRCHLO3",304,0) Q "RTN","PRCHLO3",305,0) AD1358H ; Write File 424.1 header (1358 Authorization Detail) "RTN","PRCHLO3",306,0) W "PoIdNum^PurchaseOrderNum^PoDate^MonthYrRun^StationNum^BillNumber^RecordType^AuthPointerIEN^AuthPointerEXT^AuthAmount^" "RTN","PRCHLO3",307,0) W "DateTime^UserDUZ^UserName^UserSVCint^UserSVCext^" "RTN","PRCHLO3",308,0) W "VendorInvoiceNumber^FinalBill^Reference^LastEditedByDUZ^" "RTN","PRCHLO3",309,0) W "LastEditedByName^LastEditedBySVCint^LastEditedBySVCext^Description",! "RTN","PRCHLO3",310,0) Q "RTN","PRCHLO3",311,0) AD1358W ; Write File 424.1 data (1358 Authorization Detail) "RTN","PRCHLO3",312,0) N GPOID,GPOND "RTN","PRCHLO3",313,0) S GPOID=0,GPOND="" "RTN","PRCHLO3",314,0) F S GPOID=$O(^TMP($J,"AD1358",GPOID)) Q:GPOID="" D "RTN","PRCHLO3",315,0) . F S GPOND=$O(^TMP($J,"AD1358",GPOID,GPOND)) Q:GPOND="" D "RTN","PRCHLO3",316,0) . . W $G(^TMP($J,"AD1358",GPOID,GPOND)),! "RTN","PRCHLO3",317,0) . . Q "RTN","PRCHLO3",318,0) . Q "RTN","PRCHLO3",319,0) Q "RTN","PRCHLO4") 0^9^B120154139^B89091376 "RTN","PRCHLO4",1,0) PRCHLO4 ;WOIFO/RLL/DAP-EXTRACT ROUTINE CLO REPORT SERVER ;5/22/09 14:14 "RTN","PRCHLO4",2,0) ;;5.1;IFCAP;**83,98,130**;Oct 20, 2000;Build 25 "RTN","PRCHLO4",3,0) ;Per VHA Directive 2004-038, this routine should not be modified. "RTN","PRCHLO4",4,0) ; Continuation of PRCHLO3 "RTN","PRCHLO4",5,0) ; "RTN","PRCHLO4",6,0) ; PRCHLO3 routines are used to Write out the Header and data "RTN","PRCHLO4",7,0) ; associated with each of the 23 tables created for the Clinical "RTN","PRCHLO4",8,0) ; logistics Report Server. The files are built from the extracts "RTN","PRCHLO4",9,0) ; located in the ^TMP($J) global. "RTN","PRCHLO4",10,0) ; "RTN","PRCHLO4",11,0) Q "RTN","PRCHLO4",12,0) GETDIR ; Get directory from System parameter for CLRS "RTN","PRCHLO4",13,0) S FILEDIR=$$GET^XPAR("SYS","PRCPLO EXTRACT DIRECTORY",1,"Q") "RTN","PRCHLO4",14,0) ; "RTN","PRCHLO4",15,0) Q "RTN","PRCHLO4",16,0) CLRSFIL ; Create output files for CLRS "RTN","PRCHLO4",17,0) N FILEDIR "RTN","PRCHLO4",18,0) S FILEDIR=$$GET^XPAR("SYS","PRCPLO EXTRACT DIRECTORY",1,"Q") "RTN","PRCHLO4",19,0) ; GET station id "RTN","PRCHLO4",20,0) N STID "RTN","PRCHLO4",21,0) ; S STID=$G(^DD("SITE",1)) Old call "RTN","PRCHLO4",22,0) S STID=$$GET1^DIQ(4,$$KSP^XUPARAM("INST")_",",99) "RTN","PRCHLO4",23,0) TSTFIL ; Test entry point "RTN","PRCHLO4",24,0) ; "RTN","PRCHLO4",25,0) D POMASTF ; Po Master Data "RTN","PRCHLO4",26,0) D POOBF ; Po Obligation Data "RTN","PRCHLO4",27,0) D POMETHF ; PO Method of Purchase Data "RTN","PRCHLO4",28,0) D PODISCF ; PO Discount Data "RTN","PRCHLO4",29,0) D POITMF ; Po Item Data "RTN","PRCHLO4",30,0) D POITIVF ; PO Item Inventory Point Data "RTN","PRCHLO4",31,0) D POITDRF ; PO Item Desc Data "RTN","PRCHLO4",32,0) D PODSCF ; PO Description "RTN","PRCHLO4",33,0) D POPRTF ; PO Partial Data "RTN","PRCHLO4",34,0) D PO2237F ; PO 2237 data "RTN","PRCHLO4",35,0) D POBOCF ; PO BOC Data "RTN","PRCHLO4",36,0) D POCOMF ; PO Comments data "RTN","PRCHLO4",37,0) D POREMF ; PO Remarks data "RTN","PRCHLO4",38,0) D POPPTF ; PO Prompt Payment Terms data "RTN","PRCHLO4",39,0) D POAMTF ; PO Amount data "RTN","PRCHLO4",40,0) D POAMDF ; PO Amendment Data "RTN","PRCHLO4",41,0) D POAMDCF ; PO Amendment Changes Data "RTN","PRCHLO4",42,0) D POAMDDF ; PO Amendment Description Data "RTN","PRCHLO4",43,0) D POAMBKF ; PO Amount Breakout Code Data "RTN","PRCHLO4",44,0) D FIL410 ; FILE 410 "RTN","PRCHLO4",45,0) D FIL424 ; FILE 424 "RTN","PRCHLO4",46,0) D FIL4241 ; FILE 424.1 "RTN","PRCHLO4",47,0) GIPBL1 ; GIP REPORTS "RTN","PRCHLO4",48,0) D BLDGP1^PRCPLO3 "RTN","PRCHLO4",49,0) D BLDGP2^PRCPLO3 "RTN","PRCHLO4",50,0) Q "RTN","PRCHLO4",51,0) POMASTF ; Save PO Master table data to a file to FTP to report Server "RTN","PRCHLO4",52,0) ; build file name "RTN","PRCHLO4",53,0) N OUTFIL1 "RTN","PRCHLO4",54,0) S OUTFIL1="IFCP"_STID_"F1.TXT" "RTN","PRCHLO4",55,0) D OPEN^%ZISH("FILE1",FILEDIR,OUTFIL1,"W") ; Open the file "RTN","PRCHLO4",56,0) D USE^%ZISUTL("FILE1") ; Use the file as the output device "RTN","PRCHLO4",57,0) D POMASTH^PRCHLO3 ; Write the Header to the file "RTN","PRCHLO4",58,0) D POMASTW^PRCHLO3 ; Write the data to the file "RTN","PRCHLO4",59,0) D CLOSE^%ZISH("FILE1") ; Close the file "RTN","PRCHLO4",60,0) Q "RTN","PRCHLO4",61,0) POOBF ; Create flat file for PO OBLIGATION DATA "RTN","PRCHLO4",62,0) N OUTFIL2 "RTN","PRCHLO4",63,0) S OUTFIL2="IFCP"_STID_"F2.TXT" "RTN","PRCHLO4",64,0) D OPEN^%ZISH("FILE1",FILEDIR,OUTFIL2,"W") ; Open the file "RTN","PRCHLO4",65,0) D USE^%ZISUTL("FILE1") ; Use the file as the output device "RTN","PRCHLO4",66,0) D POOBHD^PRCHLO3 "RTN","PRCHLO4",67,0) D POOBW^PRCHLO3 "RTN","PRCHLO4",68,0) D CLOSE^%ZISH("FILE1") ; Close the file "RTN","PRCHLO4",69,0) Q "RTN","PRCHLO4",70,0) POMETHF ; Create flat for for Purchase Order Method "RTN","PRCHLO4",71,0) N OUTFIL3 "RTN","PRCHLO4",72,0) S OUTFIL3="IFCP"_STID_"F3.TXT" "RTN","PRCHLO4",73,0) D OPEN^%ZISH("FILE1",FILEDIR,OUTFIL3,"W") ; Open the file "RTN","PRCHLO4",74,0) D USE^%ZISUTL("FILE1") ; Use the file as the output device "RTN","PRCHLO4",75,0) D POPMEH^PRCHLO3 "RTN","PRCHLO4",76,0) D POPMEW^PRCHLO3 "RTN","PRCHLO4",77,0) D CLOSE^%ZISH("FILE1") ; Close the file "RTN","PRCHLO4",78,0) Q "RTN","PRCHLO4",79,0) PODISCF ; Create flat file for Purchase Order Discount "RTN","PRCHLO4",80,0) N OUTFIL4 "RTN","PRCHLO4",81,0) S OUTFIL4="IFCP"_STID_"F4.TXT" "RTN","PRCHLO4",82,0) D OPEN^%ZISH("FILE1",FILEDIR,OUTFIL4,"W") ; Open the file "RTN","PRCHLO4",83,0) D USE^%ZISUTL("FILE1") "RTN","PRCHLO4",84,0) D PODISCH^PRCHLO1 "RTN","PRCHLO4",85,0) D PODISCW^PRCHLO1 "RTN","PRCHLO4",86,0) D CLOSE^%ZISH("FILE1") "RTN","PRCHLO4",87,0) Q "RTN","PRCHLO4",88,0) POITMF ; Create flat file for PO Item data "RTN","PRCHLO4",89,0) N OUTFIL5 "RTN","PRCHLO4",90,0) S OUTFIL5="IFCP"_STID_"F5.TXT" "RTN","PRCHLO4",91,0) D OPEN^%ZISH("FILE1",FILEDIR,OUTFIL5,"W") ; Open the file "RTN","PRCHLO4",92,0) D USE^%ZISUTL("FILE1") "RTN","PRCHLO4",93,0) D POITEMH^PRCHLO2 "RTN","PRCHLO4",94,0) D POITEMW^PRCHLO2 "RTN","PRCHLO4",95,0) D CLOSE^%ZISH("FILE1") "RTN","PRCHLO4",96,0) Q "RTN","PRCHLO4",97,0) POITIVF ; Create flat file for PO Item inv. point data "RTN","PRCHLO4",98,0) N OUTFIL6 "RTN","PRCHLO4",99,0) S OUTFIL6="IFCP"_STID_"F6.TXT" "RTN","PRCHLO4",100,0) D OPEN^%ZISH("FILE1",FILEDIR,OUTFIL6,"W") ; Open the file "RTN","PRCHLO4",101,0) D USE^%ZISUTL("FILE1") "RTN","PRCHLO4",102,0) D POITLNH^PRCHLO2 "RTN","PRCHLO4",103,0) D POITLNW^PRCHLO2 "RTN","PRCHLO4",104,0) D CLOSE^%ZISH("FILE1") "RTN","PRCHLO4",105,0) Q "RTN","PRCHLO4",106,0) POITDRF ; Create flat file for PO Item date received "RTN","PRCHLO4",107,0) N OUTFIL7 "RTN","PRCHLO4",108,0) S OUTFIL7="IFCP"_STID_"F7.TXT" "RTN","PRCHLO4",109,0) D OPEN^%ZISH("FILE1",FILEDIR,OUTFIL7,"W") ; Open the file "RTN","PRCHLO4",110,0) D USE^%ZISUTL("FILE1") "RTN","PRCHLO4",111,0) D POITDRCH^PRCHLO2 "RTN","PRCHLO4",112,0) D POITDRCW^PRCHLO2 "RTN","PRCHLO4",113,0) D CLOSE^%ZISH("FILE1") "RTN","PRCHLO4",114,0) Q "RTN","PRCHLO4",115,0) PODSCF ; Create flat file for PO item description "RTN","PRCHLO4",116,0) N OUTFIL8 "RTN","PRCHLO4",117,0) S OUTFIL8="IFCP"_STID_"F8.TXT" "RTN","PRCHLO4",118,0) D OPEN^%ZISH("FILE1",FILEDIR,OUTFIL8,"W") ; Open the file "RTN","PRCHLO4",119,0) D USE^%ZISUTL("FILE1") "RTN","PRCHLO4",120,0) D POITDSH^PRCHLO2 "RTN","PRCHLO4",121,0) D POITDSW^PRCHLO2 "RTN","PRCHLO4",122,0) D CLOSE^%ZISH("FILE1") "RTN","PRCHLO4",123,0) Q "RTN","PRCHLO4",124,0) POPRTF ; Create flat file for PO Partial data "RTN","PRCHLO4",125,0) N OUTFIL9 "RTN","PRCHLO4",126,0) S OUTFIL9="IFCP"_STID_"F9.TXT" "RTN","PRCHLO4",127,0) D OPEN^%ZISH("FILE1",FILEDIR,OUTFIL9,"W") ; Open the file "RTN","PRCHLO4",128,0) D USE^%ZISUTL("FILE1") "RTN","PRCHLO4",129,0) D POPART^PRCHLO3 "RTN","PRCHLO4",130,0) D POPARTW^PRCHLO3 "RTN","PRCHLO4",131,0) D CLOSE^%ZISH("FILE1") "RTN","PRCHLO4",132,0) Q "RTN","PRCHLO4",133,0) PO2237F ; Create flat file for 2237 data "RTN","PRCHLO4",134,0) N OUTFIL10 "RTN","PRCHLO4",135,0) S OUTFIL10="IFCP"_STID_"F10.TXT" "RTN","PRCHLO4",136,0) D OPEN^%ZISH("FILE1",FILEDIR,OUTFIL10,"W") ; Open the file "RTN","PRCHLO4",137,0) D USE^%ZISUTL("FILE1") "RTN","PRCHLO4",138,0) D PO2237H^PRCHLO3 "RTN","PRCHLO4",139,0) D PO2237W^PRCHLO3 "RTN","PRCHLO4",140,0) D CLOSE^%ZISH("FILE1") "RTN","PRCHLO4",141,0) Q "RTN","PRCHLO4",142,0) POBOCF ; Create flat file for PO BOC data "RTN","PRCHLO4",143,0) N OUTFIL11 "RTN","PRCHLO4",144,0) S OUTFIL11="IFCP"_STID_"F11.TXT" "RTN","PRCHLO4",145,0) D OPEN^%ZISH("FILE1",FILEDIR,OUTFIL11,"W") "RTN","PRCHLO4",146,0) D USE^%ZISUTL("FILE1") "RTN","PRCHLO4",147,0) D POBOCH^PRCHLO3 "RTN","PRCHLO4",148,0) D POBOCW^PRCHLO3 "RTN","PRCHLO4",149,0) D CLOSE^%ZISH("FILE1") "RTN","PRCHLO4",150,0) Q "RTN","PRCHLO4",151,0) POCOMF ; Create flat file for PO Comments "RTN","PRCHLO4",152,0) N OUTFIL12 "RTN","PRCHLO4",153,0) S OUTFIL12="IFCP"_STID_"F12.TXT" "RTN","PRCHLO4",154,0) D OPEN^%ZISH("FILE1",FILEDIR,OUTFIL12,"W") "RTN","PRCHLO4",155,0) D USE^%ZISUTL("FILE1") "RTN","PRCHLO4",156,0) D POCMTSH^PRCHLO3 "RTN","PRCHLO4",157,0) D POCMTSW^PRCHLO3 "RTN","PRCHLO4",158,0) D CLOSE^%ZISH("FILE1") "RTN","PRCHLO4",159,0) Q "RTN","PRCHLO4",160,0) POREMF ; Create flat file for PO Remarks "RTN","PRCHLO4",161,0) N OUTFIL13 "RTN","PRCHLO4",162,0) S OUTFIL13="IFCP"_STID_"F13.TXT" "RTN","PRCHLO4",163,0) D OPEN^%ZISH("FILE1",FILEDIR,OUTFIL13,"W") "RTN","PRCHLO4",164,0) D USE^%ZISUTL("FILE1") "RTN","PRCHLO4",165,0) D PORMKH^PRCHLO3 "RTN","PRCHLO4",166,0) D PORMKW^PRCHLO3 "RTN","PRCHLO4",167,0) D CLOSE^%ZISH("FILE1") "RTN","PRCHLO4",168,0) Q "RTN","PRCHLO4",169,0) POPPTF ; Create flat file for PO Prompt payment terms data "RTN","PRCHLO4",170,0) N OUTFIL14 "RTN","PRCHLO4",171,0) S OUTFIL14="IFCP"_STID_"F14.TXT" "RTN","PRCHLO4",172,0) D OPEN^%ZISH("FILE1",FILEDIR,OUTFIL14,"W") "RTN","PRCHLO4",173,0) D USE^%ZISUTL("FILE1") "RTN","PRCHLO4",174,0) D POPPTH^PRCHLO3 "RTN","PRCHLO4",175,0) D POPPTW^PRCHLO3 "RTN","PRCHLO4",176,0) D CLOSE^%ZISH("FILE1") "RTN","PRCHLO4",177,0) Q "RTN","PRCHLO4",178,0) POAMTF ; Create flat file for PO Amount data "RTN","PRCHLO4",179,0) N OUTFIL15 "RTN","PRCHLO4",180,0) S OUTFIL15="IFCP"_STID_"F15.TXT" "RTN","PRCHLO4",181,0) D OPEN^%ZISH("FILE1",FILEDIR,OUTFIL15,"W") "RTN","PRCHLO4",182,0) D USE^%ZISUTL("FILE1") "RTN","PRCHLO4",183,0) D POAMTH^PRCHLO3 "RTN","PRCHLO4",184,0) D POAMTW^PRCHLO3 "RTN","PRCHLO4",185,0) D CLOSE^%ZISH("FILE1") "RTN","PRCHLO4",186,0) Q "RTN","PRCHLO4",187,0) POAMDF ; Create flat file for PO Amendment data "RTN","PRCHLO4",188,0) N OUTFIL16 "RTN","PRCHLO4",189,0) S OUTFIL16="IFCP"_STID_"F16.TXT" "RTN","PRCHLO4",190,0) D OPEN^%ZISH("FILE1",FILEDIR,OUTFIL16,"W") "RTN","PRCHLO4",191,0) D USE^%ZISUTL("FILE1") "RTN","PRCHLO4",192,0) D POAMDH^PRCHLO3 "RTN","PRCHLO4",193,0) D POAMDW^PRCHLO3 "RTN","PRCHLO4",194,0) D CLOSE^%ZISH("FILE1") "RTN","PRCHLO4",195,0) Q "RTN","PRCHLO4",196,0) POAMDCF ; Create flat file for PO Amendment changes "RTN","PRCHLO4",197,0) N OUTFIL17 "RTN","PRCHLO4",198,0) S OUTFIL17="IFCP"_STID_"F17.TXT" "RTN","PRCHLO4",199,0) D OPEN^%ZISH("FILE1",FILEDIR,OUTFIL17,"W") "RTN","PRCHLO4",200,0) D USE^%ZISUTL("FILE1") "RTN","PRCHLO4",201,0) D POAMDCH^PRCHLO3 "RTN","PRCHLO4",202,0) D POAMDCW^PRCHLO3 "RTN","PRCHLO4",203,0) D CLOSE^%ZISH("FILE1") "RTN","PRCHLO4",204,0) Q "RTN","PRCHLO4",205,0) POAMDDF ; Create flat file for PO Amendment Desc data "RTN","PRCHLO4",206,0) N OUTFIL18 "RTN","PRCHLO4",207,0) S OUTFIL18="IFCP"_STID_"F18.TXT" "RTN","PRCHLO4",208,0) D OPEN^%ZISH("FILE1",FILEDIR,OUTFIL18,"W") "RTN","PRCHLO4",209,0) D USE^%ZISUTL("FILE1") "RTN","PRCHLO4",210,0) D PAMDDH^PRCHLO3 "RTN","PRCHLO4",211,0) D PAMDDW^PRCHLO3 "RTN","PRCHLO4",212,0) D CLOSE^%ZISH("FILE1") "RTN","PRCHLO4",213,0) Q "RTN","PRCHLO4",214,0) POAMBKF ; Create flat file for PO amount breakout code "RTN","PRCHLO4",215,0) N OUTFIL19 "RTN","PRCHLO4",216,0) S OUTFIL19="IFCP"_STID_"F19.TXT" "RTN","PRCHLO4",217,0) D OPEN^%ZISH("FILE1",FILEDIR,OUTFIL19,"W") "RTN","PRCHLO4",218,0) D USE^%ZISUTL("FILE1") "RTN","PRCHLO4",219,0) D PAMTBKH^PRCHLO3 "RTN","PRCHLO4",220,0) D PAMTBKW^PRCHLO3 "RTN","PRCHLO4",221,0) D CLOSE^%ZISH("FILE1") "RTN","PRCHLO4",222,0) Q "RTN","PRCHLO4",223,0) FIL410 ; Create flat file for file 410 (Control Point Activity) "RTN","PRCHLO4",224,0) N OUTFIL20 "RTN","PRCHLO4",225,0) S OUTFIL20="IFCP"_STID_"F20.TXT" "RTN","PRCHLO4",226,0) D OPEN^%ZISH("FILE1",FILEDIR,OUTFIL20,"W") "RTN","PRCHLO4",227,0) D USE^%ZISUTL("FILE1") "RTN","PRCHLO4",228,0) D CONTRPH^PRCHLO3 "RTN","PRCHLO4",229,0) D CONTRPW^PRCHLO3 "RTN","PRCHLO4",230,0) D CLOSE^%ZISH("FILE1") "RTN","PRCHLO4",231,0) N OUTFIL21 "RTN","PRCHLO4",232,0) S OUTFIL21="IFCP"_STID_"F21.TXT" "RTN","PRCHLO4",233,0) D OPEN^%ZISH("FILE1",FILEDIR,OUTFIL21,"W") "RTN","PRCHLO4",234,0) D USE^%ZISUTL("FILE1") "RTN","PRCHLO4",235,0) D SUBCPH^PRCHLO3 "RTN","PRCHLO4",236,0) D SUBCPW^PRCHLO3 "RTN","PRCHLO4",237,0) D CLOSE^%ZISH("FILE1") "RTN","PRCHLO4",238,0) Q "RTN","PRCHLO4",239,0) FIL424 ; Create flat file for file 424 (1358 Daily Record) "RTN","PRCHLO4",240,0) N OUTFIL22 "RTN","PRCHLO4",241,0) S OUTFIL22="IFCP"_STID_"F22.TXT" "RTN","PRCHLO4",242,0) D OPEN^%ZISH("FILE1",FILEDIR,OUTFIL22,"W") "RTN","PRCHLO4",243,0) D USE^%ZISUTL("FILE1") "RTN","PRCHLO4",244,0) D DR1358H^PRCHLO3 "RTN","PRCHLO4",245,0) D DR1358W^PRCHLO3 "RTN","PRCHLO4",246,0) D CLOSE^%ZISH("FILE1") "RTN","PRCHLO4",247,0) Q "RTN","PRCHLO4",248,0) FIL4241 ;Create flat file for file 424.1 (1358 Authorization Detail) "RTN","PRCHLO4",249,0) N OUTFIL23 "RTN","PRCHLO4",250,0) S OUTFIL23="IFCP"_STID_"F23.TXT" "RTN","PRCHLO4",251,0) D OPEN^%ZISH("FILE1",FILEDIR,OUTFIL23,"W") "RTN","PRCHLO4",252,0) D USE^%ZISUTL("FILE1") "RTN","PRCHLO4",253,0) D AD1358H^PRCHLO3 "RTN","PRCHLO4",254,0) D AD1358W^PRCHLO3 "RTN","PRCHLO4",255,0) D CLOSE^%ZISH("FILE1") "RTN","PRCHLO4",256,0) Q "RTN","PRCHLO4",257,0) TSTF ; Test directory for file creation "RTN","PRCHLO4",258,0) N FILEDIR,TFILE,OUTFILT,POP,STID "RTN","PRCHLO4",259,0) ; POP is returned by OPEN^%ZISH if file cannot be created. "RTN","PRCHLO4",260,0) S POP="" "RTN","PRCHLO4",261,0) S STID=$$GET1^DIQ(4,$$KSP^XUPARAM("INST")_",",99) "RTN","PRCHLO4",262,0) S OUTFILT="CLRSREADME"_STID_".TXT" "RTN","PRCHLO4",263,0) S FILEDIR=$$GET^XPAR("SYS","PRCPLO EXTRACT DIRECTORY",1,"Q") "RTN","PRCHLO4",264,0) D OPEN^%ZISH("TFILE",FILEDIR,OUTFILT,"W") "RTN","PRCHLO4",265,0) I POP D "RTN","PRCHLO4",266,0) . S CLRSERR=2 "RTN","PRCHLO4",267,0) . Q "RTN","PRCHLO4",268,0) I CLRSERR'=2 D "RTN","PRCHLO4",269,0) . D USE^%ZISUTL("TFILE") "RTN","PRCHLO4",270,0) . W !,"$ ! This directory is used to store PO activity" "RTN","PRCHLO4",271,0) . W !,"$ ! extracts and GIP Extracts which are transmitted" "RTN","PRCHLO4",272,0) . W !,"$ ! to the Clinical Logistics Report Server on a monthly" "RTN","PRCHLO4",273,0) . W !,"$ ! basis. There are 25 extract files IFCPXXXF1 through" "RTN","PRCHLO4",274,0) . W !,"$ ! IFCPXXXF23, IFCPXXXG1 and IFCPXXXG2. In addition, there" "RTN","PRCHLO4",275,0) . W !,"$ ! are 2 working files used for the FTP Transfer:" "RTN","PRCHLO4",276,0) . W !,"$ ! CLRSxxx.DAT and CLRS1xxx.COM. CLRSREADMExxx.TXT is also present" "RTN","PRCHLO4",277,0) . W !,"$ EXIT" "RTN","PRCHLO4",278,0) . D CLOSE^%ZISH("TFILE") "RTN","PRCHLO4",279,0) . Q "RTN","PRCHLO4",280,0) Q "RTN","PRCHLO4",281,0) ; "RTN","PRCHLO4",282,0) CRTCOM ; Create .DAT file to transfer file(s) "RTN","PRCHLO4",283,0) N FILEDIR,POP,STID,OUTFLL1 "RTN","PRCHLO4",284,0) ; PRC*5.1*130 begin "RTN","PRCHLO4",285,0) N PRCHUSN,PRCHPSW "RTN","PRCHLO4",286,0) S PRCHUSN=$$GET^XPAR("SYS","PRCPLO USER NAME",1,"Q") "RTN","PRCHLO4",287,0) I PRCHUSN="" S PRCPMSG(1)="There is no user name identified in the CLRS USER NAME Parameter.",PRCPMSG(2)="Please correct and retry." D MAILFTP^PRCHLO4A S CLRSERR=3 Q "RTN","PRCHLO4",288,0) S PRCHUSN=$$DECRYP^XUSRB1(PRCHUSN) "RTN","PRCHLO4",289,0) S PRCHPSW=$$GET^XPAR("SYS","PRCPLO PASSWORD",1,"Q") "RTN","PRCHLO4",290,0) I PRCHPSW="" S PRCPMSG(1)="There is no password identified in the CLRS PASSWORD Parameter.",PRCPMSG(2)="Please correct and retry." D MAILFTP^PRCHLO4A S CLRSERR=3 Q "RTN","PRCHLO4",291,0) S PRCHPSW=$$DECRYP^XUSRB1(PRCHPSW) "RTN","PRCHLO4",292,0) ; PRC*5.1*130 end "RTN","PRCHLO4",293,0) S STID=$$GET1^DIQ(4,$$KSP^XUPARAM("INST")_",",99) "RTN","PRCHLO4",294,0) S POP="" ; POP is returned by OPEN^%ZISH "RTN","PRCHLO4",295,0) ; S FILEDIR="$1$DGA2:[ANONYMOUS.CLRS]" ;set dir for outpt files. "RTN","PRCHLO4",296,0) S FILEDIR=$$GET^XPAR("SYS","PRCPLO EXTRACT DIRECTORY",1,"Q") "RTN","PRCHLO4",297,0) S OUTFLL1="CLRS"_STID_"FTP.DAT" "RTN","PRCHLO4",298,0) D OPEN^%ZISH("FILE1",FILEDIR,OUTFLL1,"W") "RTN","PRCHLO4",299,0) I POP D "RTN","PRCHLO4",300,0) . S CLRSERR=3 "RTN","PRCHLO4",301,0) . Q "RTN","PRCHLO4",302,0) I CLRSERR'=3 D "RTN","PRCHLO4",303,0) . D USE^%ZISUTL("FILE1") "RTN","PRCHLO4",304,0) . ; Enter user name and password for Report Server Login ; PRC*5.1*130 "RTN","PRCHLO4",305,0) . W PRCHUSN,!,PRCHPSW,! "RTN","PRCHLO4",306,0) . W "SET DEFAULT /LOCAL "_FILEDIR,! "RTN","PRCHLO4",307,0) . W "PUT IFCP"_STID_"*.*;*",! ; new code to issue PUT command "RTN","PRCHLO4",308,0) . W "EXIT",! ; Exit FTP "RTN","PRCHLO4",309,0) . D CLOSE^%ZISH("FILE1") "RTN","PRCHLO4",310,0) . Q "RTN","PRCHLO4",311,0) Q "RTN","PRCHLO4",312,0) CRTCOM1 ; Run CLRSFTP1.COM as com file for exception handling "RTN","PRCHLO4",313,0) ; "RTN","PRCHLO4",314,0) ;*98 Modified code to work with PRC CLRS ADDRESS parameter "RTN","PRCHLO4",315,0) ; "RTN","PRCHLO4",316,0) N FILEDIR,STID,OUTFLL2,ADDR "RTN","PRCHLO4",317,0) S STID=$$GET1^DIQ(4,$$KSP^XUPARAM("INST")_",",99) "RTN","PRCHLO4",318,0) S FILEDIR=$$GET^XPAR("SYS","PRCPLO EXTRACT DIRECTORY",1,"Q") "RTN","PRCHLO4",319,0) S ADDR=$$GET^XPAR("SYS","PRC CLRS ADDRESS",1,"Q") "RTN","PRCHLO4",320,0) I ADDR="" S PRCPMSG(1)="There is no address identified in the CLRS Address Parameter.",PRCPMSG(2)="Please correct and retry." D MAILFTP^PRCHLO4A S CLRSERR=1 Q "RTN","PRCHLO4",321,0) S OUTFLL2="CLRS"_STID_"FTP1.COM" "RTN","PRCHLO4",322,0) D OPEN^%ZISH("FILE1",FILEDIR,OUTFLL2,"W") "RTN","PRCHLO4",323,0) D USE^%ZISUTL("FILE1") "RTN","PRCHLO4",324,0) W "$ SET VERIFY=(PROCEDURE,IMAGE)",! "RTN","PRCHLO4",325,0) W "$ SET DEFAULT "_FILEDIR,! "RTN","PRCHLO4",326,0) W "$ FTP "_ADDR_" /INPUT="_FILEDIR_"CLRS"_STID_"FTP.DAT",! "RTN","PRCHLO4",327,0) ; "RTN","PRCHLO4",328,0) W "$ EXIT 3",! "RTN","PRCHLO4",329,0) D CLOSE^%ZISH("FILE1") "RTN","PRCHLO4",330,0) Q "RTN","PRCHLO4",331,0) FTPCOM ; Issue the FTP command after CLRS1.TXT file is built "RTN","PRCHLO4",332,0) ; remain in CACHE during FTP Process using "RTN","PRCHLO4",333,0) ; $ZF(-1) call "RTN","PRCHLO4",334,0) ; ; SACC Exception received for usage of $ZF(-1) in PRC*5.1*83 "RTN","PRCHLO4",335,0) ; See IFCAP technical manual "RTN","PRCHLO4",336,0) ; "RTN","PRCHLO4",337,0) ; commented out for testing "RTN","PRCHLO4",338,0) ; add hook to mailman messaging for ftp, check variable PV "RTN","PRCHLO4",339,0) N PV,XPV1,FILEDIR,STID "RTN","PRCHLO4",340,0) ; "RTN","PRCHLO4",341,0) ; "RTN","PRCHLO4",342,0) S FILEDIR=$$GET^XPAR("SYS","PRCPLO EXTRACT DIRECTORY",1,"Q") "RTN","PRCHLO4",343,0) S STID=$$GET1^DIQ(4,$$KSP^XUPARAM("INST")_",",99) "RTN","PRCHLO4",344,0) S XPV1="S PV=$ZF(-1,""@"_FILEDIR_"CLRS"_STID_"FTP1.COM/OUTPUT="_FILEDIR_"CLRS"_STID_"FTP1.LOG"")" "RTN","PRCHLO4",345,0) X XPV1 ; Run the .COM file to transfer files "RTN","PRCHLO4",346,0) ; "RTN","PRCHLO4",347,0) ; Error flag logic "RTN","PRCHLO4",348,0) I PV=-1 D ; This error is generated if failure during xfer occurs "RTN","PRCHLO4",349,0) . S CLRSERR=1 "RTN","PRCHLO4",350,0) . Q "RTN","PRCHLO4",351,0) Q "RTN","PRCHLO4A") 0^10^B72350733^B64544632 "RTN","PRCHLO4A",1,0) PRCHLO4A ;WOIFO/RLL/DAP-EXTRACT ROUTINE CLO REPORT SERVER ;5/22/09 14:14 "RTN","PRCHLO4A",2,0) ;;5.1;IFCAP;**83,104,98,130**;Oct 20, 2000;Build 25 "RTN","PRCHLO4A",3,0) ;Per VHA Directive 2004-038, this routine should not be modified. "RTN","PRCHLO4A",4,0) ; Continuation of PRCHLO4 "RTN","PRCHLO4A",5,0) ; "RTN","PRCHLO4A",6,0) ; PRCHLO4A routines are used to Write out the Header and data "RTN","PRCHLO4A",7,0) ; "RTN","PRCHLO4A",8,0) Q "RTN","PRCHLO4A",9,0) GETDIR ; Get directory from PRCPLO EXTRACT DIRECTORY system parameter for CLRS "RTN","PRCHLO4A",10,0) N FILEDIR,STID "RTN","PRCHLO4A",11,0) S STID=$$GET1^DIQ(4,$$KSP^XUPARAM("INST")_",",99) "RTN","PRCHLO4A",12,0) S FILEDIR=$$GET^XPAR("SYS","PRCPLO EXTRACT DIRECTORY",1,"Q") "RTN","PRCHLO4A",13,0) ; "RTN","PRCHLO4A",14,0) Q "RTN","PRCHLO4A",15,0) ; "RTN","PRCHLO4A",16,0) CRTWIN ; Create CLRSxxxWFTP.TXT file to transfer file(s) "RTN","PRCHLO4A",17,0) ;*98 Modified to work with PRC CLRS ADDRESS parameter "RTN","PRCHLO4A",18,0) N FILEDIR,POP,STID,OUTFLL1,ADDR "RTN","PRCHLO4A",19,0) ; PRC*5.1*130 begin "RTN","PRCHLO4A",20,0) N PRCHUSN,PRCHPSW "RTN","PRCHLO4A",21,0) ; PRC*5.1*130 end "RTN","PRCHLO4A",22,0) S STID=$$GET1^DIQ(4,$$KSP^XUPARAM("INST")_",",99) "RTN","PRCHLO4A",23,0) S POP="" ; POP is returned by OPEN^%ZISH "RTN","PRCHLO4A",24,0) S FILEDIR=$$GET^XPAR("SYS","PRCPLO EXTRACT DIRECTORY",1,"Q") "RTN","PRCHLO4A",25,0) ; RLL/PRC*5.1*104 change logic to create separate FTP "RTN","PRCHLO4A",26,0) ; transfer files (1 for each file for Windows/Cache) "RTN","PRCHLO4A",27,0) S ADDR=$$GET^XPAR("SYS","PRC CLRS ADDRESS",1,"Q") "RTN","PRCHLO4A",28,0) I ADDR="" S PRCPMSG(1)="There is no address identified in the CLRS Adress Parameter.",PRCPMSG(2)="Please correct and retry." D MAILFTP S CLRSERR=1 Q "RTN","PRCHLO4A",29,0) ; PRC*5.1*130 begin "RTN","PRCHLO4A",30,0) S PRCHUSN=$$GET^XPAR("SYS","PRCPLO USER NAME",1,"Q") "RTN","PRCHLO4A",31,0) I PRCHUSN="" S PRCPMSG(1)="There is no user name identified in the CLRS USER NAME Parameter.",PRCPMSG(2)="Please correct and retry." D MAILFTP S CLRSERR=1 Q "RTN","PRCHLO4A",32,0) S PRCHUSN=$$DECRYP^XUSRB1(PRCHUSN) "RTN","PRCHLO4A",33,0) S PRCHPSW=$$GET^XPAR("SYS","PRCPLO PASSWORD",1,"Q") "RTN","PRCHLO4A",34,0) I PRCHPSW="" S PRCPMSG(1)="There is no password identified in the CLRS PASSWORD Parameter.",PRCPMSG(2)="Please correct and retry." D MAILFTP S CLRSERR=1 Q "RTN","PRCHLO4A",35,0) S PRCHPSW=$$DECRYP^XUSRB1(PRCHPSW) "RTN","PRCHLO4A",36,0) ; PRC*5.1*130 end "RTN","PRCHLO4A",37,0) ; "RTN","PRCHLO4A",38,0) I CLRSERR'=3 D "RTN","PRCHLO4A",39,0) . N PONN ; File number for File type "RTN","PRCHLO4A",40,0) . S PONN=1 "RTN","PRCHLO4A",41,0) . F PONN=1:1:23 D "RTN","PRCHLO4A",42,0) . . N FTY ; File type F=Po Activity , G=GIP "RTN","PRCHLO4A",43,0) . . ; "RTN","PRCHLO4A",44,0) . . S FTY="F" "RTN","PRCHLO4A",45,0) . . S OUTFLL1="CLRS"_STID_FTY_PONN_"WFTP.TXT" "RTN","PRCHLO4A",46,0) . . D OPEN^%ZISH("FILE1",FILEDIR,OUTFLL1,"W") "RTN","PRCHLO4A",47,0) . . I POP D "RTN","PRCHLO4A",48,0) . . . S CLRSERR=3 "RTN","PRCHLO4A",49,0) . . . Q "RTN","PRCHLO4A",50,0) . . D USE^%ZISUTL("FILE1") "RTN","PRCHLO4A",51,0) . . D BLDF1 "RTN","PRCHLO4A",52,0) . . D CLOSE^%ZISH("FILE1") "RTN","PRCHLO4A",53,0) . . Q "RTN","PRCHLO4A",54,0) . Q "RTN","PRCHLO4A",55,0) ; "RTN","PRCHLO4A",56,0) I CLRSERR'=3 D "RTN","PRCHLO4A",57,0) . ; RLL/PRC*5.1*104 change logic to create separate FTP "RTN","PRCHLO4A",58,0) . ; tranfer files (1 for each file for Windows/Cache) "RTN","PRCHLO4A",59,0) . N PONN ; File number for file type "RTN","PRCHLO4A",60,0) . S PONN=1 "RTN","PRCHLO4A",61,0) . F PONN=1:1:2 D "RTN","PRCHLO4A",62,0) . . N FTY ; File type F=Po Activity , G=GIP "RTN","PRCHLO4A",63,0) . . S FTY="G" "RTN","PRCHLO4A",64,0) . . S OUTFLL1="CLRS"_STID_FTY_PONN_"WFTP.TXT" "RTN","PRCHLO4A",65,0) . . D OPEN^%ZISH("FILE1",FILEDIR,OUTFLL1,"W") "RTN","PRCHLO4A",66,0) . . I POP D "RTN","PRCHLO4A",67,0) . . . S CLRSERR=3 "RTN","PRCHLO4A",68,0) . . . Q "RTN","PRCHLO4A",69,0) . . D USE^%ZISUTL("FILE1") "RTN","PRCHLO4A",70,0) . . D BLDF1 "RTN","PRCHLO4A",71,0) . . D CLOSE^%ZISH("FILE1") "RTN","PRCHLO4A",72,0) . . Q "RTN","PRCHLO4A",73,0) . Q "RTN","PRCHLO4A",74,0) Q "RTN","PRCHLO4A",75,0) BLDF1 ; RLL/PRC*5.1*104 added logic to create separate FTP "RTN","PRCHLO4A",76,0) ; transfers (1 for each file) "RTN","PRCHLO4A",77,0) ; "RTN","PRCHLO4A",78,0) W "open "_ADDR,! ;Connect to the Report Server "RTN","PRCHLO4A",79,0) ; PRC*5.1*130 begin "RTN","PRCHLO4A",80,0) ; Enter user name for Report Server Login "RTN","PRCHLO4A",81,0) W PRCHUSN,! "RTN","PRCHLO4A",82,0) ; Enter P/W for Report Server Login "RTN","PRCHLO4A",83,0) W PRCHPSW,! "RTN","PRCHLO4A",84,0) ; PRC*5.1*130 end "RTN","PRCHLO4A",85,0) W "PUT "_FILEDIR_"IFCP"_STID_FTY_PONN_".TXT",! "RTN","PRCHLO4A",86,0) W "bye",! ; Exit FTP "RTN","PRCHLO4A",87,0) ; "RTN","PRCHLO4A",88,0) Q "RTN","PRCHLO4A",89,0) CKRPTSV ; Check for availability of report server "RTN","PRCHLO4A",90,0) ; Several steps need to be performed "RTN","PRCHLO4A",91,0) ; 1. Set up script to perform PING "RTN","PRCHLO4A",92,0) ; 2. Capture log file during PING "RTN","PRCHLO4A",93,0) ; 3. Read logfile into working global "RTN","PRCHLO4A",94,0) ; 4. Determine Success/Failure of PING to server "RTN","PRCHLO4A",95,0) ; 5. If successful, continue processing (CLRSERR=0) "RTN","PRCHLO4A",96,0) ; 6. If problem occurs, S CLRSERR=3 and generate message "RTN","PRCHLO4A",97,0) ; "RTN","PRCHLO4A",98,0) I CKOS["VMS" D VMSPING ; CKOS set in PRCHLO5 "RTN","PRCHLO4A",99,0) I CKOS["NT" D WINPING ; CKOS set in PRCHLO5 "RTN","PRCHLO4A",100,0) Q "RTN","PRCHLO4A",101,0) VMSPING ; need to PING report server to make sure it is available "RTN","PRCHLO4A",102,0) ; "RTN","PRCHLO4A",103,0) ; 1. Create .COM file to execute "RTN","PRCHLO4A",104,0) ;*98 Modified to work with PRC CLRS ADDRESS parameter "RTN","PRCHLO4A",105,0) N FILEDIR,STID,OUTFLL2,ADDR "RTN","PRCHLO4A",106,0) S STID=$$GET1^DIQ(4,$$KSP^XUPARAM("INST")_",",99) "RTN","PRCHLO4A",107,0) S FILEDIR=$$GET^XPAR("SYS","PRCPLO EXTRACT DIRECTORY",1,"Q") "RTN","PRCHLO4A",108,0) S ADDR=$$GET^XPAR("SYS","PRC CLRS ADDRESS",1,"Q") "RTN","PRCHLO4A",109,0) I ADDR="" S PRCPMSG(1)="There is no address identified in the CLRS Address Parameter.",PRCPMSG(2)="Please correct and retry." D MAILFTP S CLRSERR=1 Q "RTN","PRCHLO4A",110,0) ; "RTN","PRCHLO4A",111,0) S OUTFLL2="CLRS"_STID_"PING.COM" "RTN","PRCHLO4A",112,0) D OPEN^%ZISH("FILE1",FILEDIR,OUTFLL2,"W") "RTN","PRCHLO4A",113,0) D USE^%ZISUTL("FILE1") "RTN","PRCHLO4A",114,0) W "$ SET VERIFY=(PROCEDURE,IMAGE)",! "RTN","PRCHLO4A",115,0) W "$ SET DEFAULT "_FILEDIR,! "RTN","PRCHLO4A",116,0) W "$ TCPIP",! "RTN","PRCHLO4A",117,0) W "PING "_ADDR,! "RTN","PRCHLO4A",118,0) W "EXIT",! "RTN","PRCHLO4A",119,0) W "$ EXIT 3",! "RTN","PRCHLO4A",120,0) D CLOSE^%ZISH("FILE1") "RTN","PRCHLO4A",121,0) ; "RTN","PRCHLO4A",122,0) ; 2. Execute .COM file, create logfile "RTN","PRCHLO4A",123,0) S XPV1="S PV=$ZF(-1,""@"_FILEDIR_"CLRS"_STID_"PING.COM/OUTPUT="_FILEDIR_"CLRS"_STID_"PING.LOG"")" "RTN","PRCHLO4A",124,0) X XPV1 ; Run the .com file "RTN","PRCHLO4A",125,0) ; "RTN","PRCHLO4A",126,0) ; 3. Read Logfile into working global "RTN","PRCHLO4A",127,0) N FNAME,XLOG "RTN","PRCHLO4A",128,0) S FNAME="CLRS"_STID_"PING.LOG" "RTN","PRCHLO4A",129,0) S XLOG=$$FTG^%ZISH(FILEDIR,FNAME,$NAME(^TMP("PRCLRSLOG",$J,1)),3) "RTN","PRCHLO4A",130,0) ; Check global for %SYSTEM or 0 packets received "RTN","PRCHLO4A",131,0) N PNG,PNG1,PNG2,PNG3 "RTN","PRCHLO4A",132,0) S PNG=0,PNG1=0,PNG2=0 "RTN","PRCHLO4A",133,0) F S PNG=$O(^TMP("PRCLRSLOG",$J,PNG)) Q:PNG="" D "RTN","PRCHLO4A",134,0) . S PNG1=$G(^TMP("PRCLRSLOG",$J,PNG)) "RTN","PRCHLO4A",135,0) . I PNG1["0 packets received" S CLRSERR=3 "RTN","PRCHLO4A",136,0) . I PNG1["%SYSTEM" S CLRSERR=3 "RTN","PRCHLO4A",137,0) . Q "RTN","PRCHLO4A",138,0) Q "RTN","PRCHLO4A",139,0) WINPING ; PING report server to make sure it is available "RTN","PRCHLO4A",140,0) ;*98 Modified to work with PRC CLRS ADDRESS parameter "RTN","PRCHLO4A",141,0) N PV,XPV1,FILEDIR,STID,XLOG,ADDR "RTN","PRCHLO4A",142,0) S FILEDIR=$$GET^XPAR("SYS","PRCPLO EXTRACT DIRECTORY",1,"Q") "RTN","PRCHLO4A",143,0) S ADDR=$$GET^XPAR("SYS","PRC CLRS ADDRESS",1,"Q") "RTN","PRCHLO4A",144,0) I ADDR="" S PRCPMSG(1)="There is no address identified in the CLRS Adress Parameter.",PRCPMSG(2)="Please correct and retry." D MAILFTP S CLRSERR=1 Q "RTN","PRCHLO4A",145,0) ; "RTN","PRCHLO4A",146,0) S STID=$$GET1^DIQ(4,$$KSP^XUPARAM("INST")_",",99) "RTN","PRCHLO4A",147,0) S XPV1="S PV=$ZF(-1,""PING "_ADDR_">"_FILEDIR_"CLRS"_STID_"PING.LOG"")" "RTN","PRCHLO4A",148,0) X XPV1 "RTN","PRCHLO4A",149,0) S FNAME="CLRS"_STID_"PING.LOG" "RTN","PRCHLO4A",150,0) S XLOG=$$FTG^%ZISH(FILEDIR,FNAME,$NAME(^TMP("PRCLRSLOG",$J,1)),3) "RTN","PRCHLO4A",151,0) N PNG,PNG1,PNG2,PNG3 "RTN","PRCHLO4A",152,0) S PNG=0,PNG1=0,PNG2=0 "RTN","PRCHLO4A",153,0) F S PNG=$O(^TMP("PRCLRSLOG",$J,PNG)) Q:PNG="" D "RTN","PRCHLO4A",154,0) . S PNG1=$G(^TMP("PRCLRSLOG",$J,PNG)) "RTN","PRCHLO4A",155,0) . I PNG1["Received = 0" S CLRSERR=3 "RTN","PRCHLO4A",156,0) . Q "RTN","PRCHLO4A",157,0) Q "RTN","PRCHLO4A",158,0) ; "RTN","PRCHLO4A",159,0) LOG2FILE ; Set logfile to global, add to mail message "RTN","PRCHLO4A",160,0) ; "RTN","PRCHLO4A",161,0) ; "RTN","PRCHLO4A",162,0) N FILEDIR,STID,FNAME,XLOG "RTN","PRCHLO4A",163,0) S FILEDIR=$$GET^XPAR("SYS","PRCPLO EXTRACT DIRECTORY",1,"Q") "RTN","PRCHLO4A",164,0) S STID=$$GET1^DIQ(4,$$KSP^XUPARAM("INST")_",",99) "RTN","PRCHLO4A",165,0) I CKOS["VMS" S FNAME="CLRS"_STID_"FTP1.LOG" "RTN","PRCHLO4A",166,0) I CKOS["NT" S FNAME="CLRS"_STID_"F1FTP1.LOG" "RTN","PRCHLO4A",167,0) S XLOG=$$FTG^%ZISH(FILEDIR,FNAME,$NAME(^TMP("PRCHLOG",$J,1)),3) "RTN","PRCHLO4A",168,0) ; Log file is in the global ^TMP("PRCHLOG", lets put it in "RTN","PRCHLO4A",169,0) ; the message beginning at PRCPMSG(11) "RTN","PRCHLO4A",170,0) ; "RTN","PRCHLO4A",171,0) N LG1,LG2,LG3,LG4,LGCNT "RTN","PRCHLO4A",172,0) S LG1=0,LG2=0,LG3=0,LG4=0,LGCNT=11 "RTN","PRCHLO4A",173,0) F S LG1=$O(^TMP("PRCHLOG",$J,LG1)) Q:LG1="" D "RTN","PRCHLO4A",174,0) . S LG3=$G(^TMP("PRCHLOG",$J,LG1)) "RTN","PRCHLO4A",175,0) . S PRCPMSG(LGCNT)=LG3 "RTN","PRCHLO4A",176,0) . S LGCNT=LGCNT+1 "RTN","PRCHLO4A",177,0) . Q "RTN","PRCHLO4A",178,0) D MAILFTP "RTN","PRCHLO4A",179,0) Q "RTN","PRCHLO4A",180,0) FTPCOM ; Issue the FTP command after CLRSxxxWFTP.TXT file is built "RTN","PRCHLO4A",181,0) ; remain in CACHE during FTP Process using "RTN","PRCHLO4A",182,0) ; $ZF(-1) call "RTN","PRCHLO4A",183,0) ; "RTN","PRCHLO4A",184,0) ; rll/ 8/30/2006 Change logic to initiate transfer one file "RTN","PRCHLO4A",185,0) ; at a time to the report server for Windows/Cache stations "RTN","PRCHLO4A",186,0) ; This was done after a hang was observed between transfers. "RTN","PRCHLO4A",187,0) ; "RTN","PRCHLO4A",188,0) N LPP1,LPP2 "RTN","PRCHLO4A",189,0) S LPP1=0,LPP2="F" "RTN","PRCHLO4A",190,0) F LPP1=1:1:23 D ; run the FTP command for the 23 PO files "RTN","PRCHLO4A",191,0) . D RUNFTPT "RTN","PRCHLO4A",192,0) . Q "RTN","PRCHLO4A",193,0) S LPP1=0,LPP2="G" "RTN","PRCHLO4A",194,0) F LPP1=1:1:2 D ; run the FTP command for the 2 GIP files "RTN","PRCHLO4A",195,0) . D RUNFTPT "RTN","PRCHLO4A",196,0) . Q "RTN","PRCHLO4A",197,0) Q "RTN","PRCHLO4A",198,0) ; "RTN","PRCHLO4A",199,0) RUNFTPT ; Run the FTP transfer for Windows "RTN","PRCHLO4A",200,0) N PV,XPV1,FILEDIR,STID "RTN","PRCHLO4A",201,0) ; "RTN","PRCHLO4A",202,0) S FILEDIR=$$GET^XPAR("SYS","PRCPLO EXTRACT DIRECTORY",1,"Q") "RTN","PRCHLO4A",203,0) S STID=$$GET1^DIQ(4,$$KSP^XUPARAM("INST")_",",99) "RTN","PRCHLO4A",204,0) ; SACC Exception received for usage of $ZF(-1) in PRC*5.1*83 "RTN","PRCHLO4A",205,0) ; See IFCAP Technical Manual "RTN","PRCHLO4A",206,0) S XPV1="S PV=$ZF(-1,""ftp -s:"_FILEDIR_"CLRS"_STID_LPP2_LPP1_"WFTP.TXT>"_FILEDIR_"CLRS"_STID_LPP2_LPP1_"FTP1.LOG"")" "RTN","PRCHLO4A",207,0) X XPV1 ; FTP the files, Comment out for testing "RTN","PRCHLO4A",208,0) ; "RTN","PRCHLO4A",209,0) ; error flag logic "RTN","PRCHLO4A",210,0) I PV=-1 D ; Note, this error is logged on system error during xfer "RTN","PRCHLO4A",211,0) . S CLRSERR=1 "RTN","PRCHLO4A",212,0) . Q "RTN","PRCHLO4A",213,0) Q "RTN","PRCHLO4A",214,0) DELWIN ; Delete windows files "RTN","PRCHLO4A",215,0) ; "RTN","PRCHLO4A",216,0) ; "RTN","PRCHLO4A",217,0) I CKOS["NT" D "RTN","PRCHLO4A",218,0) . N LPP1,LPP2 "RTN","PRCHLO4A",219,0) . S LPP1=0,LPP2="F" "RTN","PRCHLO4A",220,0) . F LPP1=1:1:23 D ; run the FTP command for the 23 PO files "RTN","PRCHLO4A",221,0) . . D DELFTPF "RTN","PRCHLO4A",222,0) . . Q "RTN","PRCHLO4A",223,0) . Q "RTN","PRCHLO4A",224,0) S LPP1=0,LPP2="G" "RTN","PRCHLO4A",225,0) F LPP1=1:1:2 D "RTN","PRCHLO4A",226,0) . D DELFTPF ; Delete the GIP files "RTN","PRCHLO4A",227,0) . Q "RTN","PRCHLO4A",228,0) Q "RTN","PRCHLO4A",229,0) DELFTPF ; Delete the FTP files, logs , and .TXT files "RTN","PRCHLO4A",230,0) ; "RTN","PRCHLO4A",231,0) N FILEDIR,STID,XPV "RTN","PRCHLO4A",232,0) S FILEDIR=$$GET^XPAR("SYS","PRCPLO EXTRACT DIRECTORY",1,"Q") "RTN","PRCHLO4A",233,0) S STID=$$GET1^DIQ(4,$$KSP^XUPARAM("INST")_",",99) "RTN","PRCHLO4A",234,0) ; delete previous extract "RTN","PRCHLO4A",235,0) S XPV="S PV=$ZF(-1,""DEL "_FILEDIR_"IFCP"_STID_LPP2_LPP1_".TXT"")" "RTN","PRCHLO4A",236,0) X XPV ; comment out for testing "RTN","PRCHLO4A",237,0) ; delete previous logfile "RTN","PRCHLO4A",238,0) ; "RTN","PRCHLO4A",239,0) S XPV="S PV=$ZF(-1,""DEL "_FILEDIR_"CLRS"_STID_LPP2_LPP1_"FTP1.LOG"")" "RTN","PRCHLO4A",240,0) X XPV ; comment out for testing "RTN","PRCHLO4A",241,0) ; delete previous ftp file for transfer "RTN","PRCHLO4A",242,0) ; "RTN","PRCHLO4A",243,0) S XPV="S PV=$ZF(-1,""DEL "_FILEDIR_"CLRS"_STID_LPP2_LPP1_"WFTP.TXT"")" "RTN","PRCHLO4A",244,0) X XPV "RTN","PRCHLO4A",245,0) Q "RTN","PRCHLO4A",246,0) ; "RTN","PRCHLO4A",247,0) MAIL ;Builds mail messages to a defined mail group to notify users of the "RTN","PRCHLO4A",248,0) ;success or failure of the TaskMan scheduling for the CLO Procurement "RTN","PRCHLO4A",249,0) ;Reports "RTN","PRCHLO4A",250,0) ; "RTN","PRCHLO4A",251,0) ;*98 Modified code to work with PRC CLRS OUTLOOK MAILGROUP parameter "RTN","PRCHLO4A",252,0) N XMDUZ,XMMG,XMSUB,XMTEXT,XMY,XMZ,PRCPMG,PRCPMG2 "RTN","PRCHLO4A",253,0) S XMSUB="CLO Procurement Report Status for "_$$HTE^XLFDT($H) "RTN","PRCHLO4A",254,0) S XMDUZ="Clinical Logistics Report Server" "RTN","PRCHLO4A",255,0) S XMTEXT="PRCPMSG(" "RTN","PRCHLO4A",256,0) S XMY("G.PRCPLO CLRS NOTIFICATIONS")="" "RTN","PRCHLO4A",257,0) S PRCPMG=$$GET^XPAR("SYS","PRC CLRS OUTLOOK MAILGROUP",1,"Q") "RTN","PRCHLO4A",258,0) S:$G(PRCPMG)'="" PRCPMG2="S XMY("""_PRCPMG_""")=""""" X PRCPMG2 "RTN","PRCHLO4A",259,0) ; "RTN","PRCHLO4A",260,0) D ^XMD "RTN","PRCHLO4A",261,0) Q "RTN","PRCHLO4A",262,0) ; "RTN","PRCHLO4A",263,0) MAILFTP ;Builds mail messages to a defined mail group to notify users of "RTN","PRCHLO4A",264,0) ;the success or failure of issues pertaining to FTP Transfer and "RTN","PRCHLO4A",265,0) ;file permissions/protections associated with VMS Directories "RTN","PRCHLO4A",266,0) ; "RTN","PRCHLO4A",267,0) ;*98 Modified code to work with PRC CLRS OUTLOOK MAILGROUP parameter "RTN","PRCHLO4A",268,0) N XMDUZ,XMMG,XMSUB,XMTEXT,XMY,XMZ,PRCPMG,PRCPMG2 "RTN","PRCHLO4A",269,0) S XMSUB="CLO Environment Check & Data Transfer for OS / FTP , "_$$HTE^XLFDT($H) "RTN","PRCHLO4A",270,0) S XMDUZ="Clinical Logistics Report Server" "RTN","PRCHLO4A",271,0) S XMTEXT="PRCPMSG(" "RTN","PRCHLO4A",272,0) S XMY("G.PRCPLO CLRS NOTIFICATIONS")="" "RTN","PRCHLO4A",273,0) S PRCPMG=$$GET^XPAR("SYS","PRC CLRS OUTLOOK MAILGROUP",1,"Q") "RTN","PRCHLO4A",274,0) S:$G(PRCPMG)'="" PRCPMG2="S XMY("""_PRCPMG_""")=""""" X PRCPMG2 "RTN","PRCHLO4A",275,0) ; "RTN","PRCHLO4A",276,0) D ^XMD "RTN","PRCHLO4A",277,0) Q "RTN","PRCHLO6") 0^13^B122486114^n/a "RTN","PRCHLO6",1,0) PRCHLO6 ;WOIFO/AS-EXTRACT ROUTINE (cont.)CLO REPORT SERVER ;5/17/09 23:45 "RTN","PRCHLO6",2,0) ;;5.1;IFCAP;**130**;Oct 20, 2000;Build 25 "RTN","PRCHLO6",3,0) ;Per VHA Directive 2004-038, this routine should not be modified. "RTN","PRCHLO6",4,0) ; DBIA 10093 - Read file 49 via FileMan. "RTN","PRCHLO6",5,0) ; Continuation of PRCHLO1. This program builds the extracts for "RTN","PRCHLO6",6,0) ; the Master PO Table and the associated multiples "RTN","PRCHLO6",7,0) GET410 ; get file 410 record "RTN","PRCHLO6",8,0) S U="^" "RTN","PRCHLO6",9,0) N PRCND,PRCIEN,PRCDT,PRCTMP,PRCTMB,PRCTR,PRCFR,PRCDAT,PRCDATO,PRCDATA,D0,X "RTN","PRCHLO6",10,0) N PRCDUZ "RTN","PRCHLO6",11,0) ; loop through file 410 "RTN","PRCHLO6",12,0) S PRCIEN=0,PRCDT="" "RTN","PRCHLO6",13,0) F S PRCIEN=$O(^PRCS(410,PRCIEN)) Q:'PRCIEN D "RTN","PRCHLO6",14,0) . S PRCND=$G(^PRCS(410,PRCIEN,0)) ;NODE 0 "RTN","PRCHLO6",15,0) . S PRCTR=$P(PRCND,U,2) ;TRANSACTION TYPE "RTN","PRCHLO6",16,0) . S PRCFR=$P(PRCND,U,4) ;FORM TYPE "RTN","PRCHLO6",17,0) . S PRCDAT=$P($G(^PRCS(410,PRCIEN,1)),U,1) ;DATE OF REQUEST "RTN","PRCHLO6",18,0) . S PRCDATO=$P($G(^PRCS(410,PRCIEN,4)),U,4) ;DATE OBLIGATED "RTN","PRCHLO6",19,0) . S PRCDATA=$P($G(^PRCS(410,PRCIEN,4)),U,7) ;DATE OBLIGATED ADJ "RTN","PRCHLO6",20,0) . ;TRANS TYPE IS ADJUSTMENT, FORM TYPE IS NOT NULL NOT ISSUE BOOK "RTN","PRCHLO6",21,0) . I PRCTR="A",PRCFR,PRCFR'=5,PRCDAT>CLOBGN,PRCDATCLOBGN,PRCDATOCLOBGN,PRCDATCLOBGN,PRCDATOCLOBGN,PRCDATA0:$P($G(^PRCS(410.5,PRCFR,0)),U),1:"")_U ;FORM TYPE "RTN","PRCHLO6",39,0) S X=$P(PRCND,U,10),PRCDT=PRCDT_X_U_$S(X>0:$P($G(^PRC(411,X,0)),U),1:"")_U ;SUBSTATION -internal and external "RTN","PRCHLO6",40,0) S X=$P(PRCND,U,11),PRCDT=PRCDT_$S(X>0:$$FMTE^XLFDT($P(X,".")),1:"")_U ;RUNNING BAL QTR DATE "RTN","PRCHLO6",41,0) S PRCDT=PRCDT_$$GET1^DIQ(410,PRCIEN_",",450)_U ;RUNNING BAL STATUS "RTN","PRCHLO6",42,0) S PRCND=$G(^PRCS(410,PRCIEN,1)) ;NODE 1 "RTN","PRCHLO6",43,0) S X=$P(PRCND,U,1),PRCDT=PRCDT_$S(X>0:$$FMTE^XLFDT($P(X,".")),1:"")_U ;DATE OF REQUEST "RTN","PRCHLO6",44,0) S PRCDT=PRCDT_$P(PRCND,U,5)_U ;CLASS OF REQUEST IEN "RTN","PRCHLO6",45,0) S PRCTMP=$P($G(^PRCS(410.2,+$P(PRCND,U,5),0)),U) "RTN","PRCHLO6",46,0) S PRCDT=PRCDT_PRCTMP_U ;CLASS OF REQUEST EXT "RTN","PRCHLO6",47,0) S PRCND=$G(^PRCS(410,PRCIEN,2)) ;NODE 2 "RTN","PRCHLO6",48,0) S PRCDT=PRCDT_$P(PRCND,U,1)_U ;VENDOR "RTN","PRCHLO6",49,0) S PRCDT=PRCDT_$P(PRCND,U,2)_U ;VENDOR ADDRESS1 "RTN","PRCHLO6",50,0) S PRCDT=PRCDT_$P(PRCND,U,3)_U ;VENDOR ADDRESS2 "RTN","PRCHLO6",51,0) S PRCDT=PRCDT_$P(PRCND,U,4)_U ;VENDOR ADDRESS3 "RTN","PRCHLO6",52,0) S PRCDT=PRCDT_$P(PRCND,U,5)_U ;VENDOR ADDRESS4 "RTN","PRCHLO6",53,0) S PRCDT=PRCDT_$P(PRCND,U,6)_U ;VENDOR CITY "RTN","PRCHLO6",54,0) S X=$P(PRCND,U,7),PRCDT=PRCDT_$S(X>0:$$GET1^DIQ(5,X_",",1),1:"")_U ;VENDOR STATE "RTN","PRCHLO6",55,0) S PRCDT=PRCDT_$P(PRCND,U,8)_U ;VENDOR ZIP CODE "RTN","PRCHLO6",56,0) S PRCDT=PRCDT_$P(PRCND,U,9)_U ;VENDOR CONTACT "RTN","PRCHLO6",57,0) S PRCDT=PRCDT_$P(PRCND,U,10)_U ;VENDOR PHONE NO. "RTN","PRCHLO6",58,0) S PRCND=$G(^PRCS(410,PRCIEN,3)) ;NODE 3 "RTN","PRCHLO6",59,0) S PRCTMP=$P(PRCND,U,4) "RTN","PRCHLO6",60,0) S PRCDT=PRCDT_PRCTMP_U,PRCTMP=+PRCTMP ;VENDOR IEN "RTN","PRCHLO6",61,0) S PRCTMB=$P($G(^PRC(440,PRCTMP,0)),U,1) ; "RTN","PRCHLO6",62,0) S PRCDT=PRCDT_PRCTMB_U ;VENDOR NAME "RTN","PRCHLO6",63,0) S PRCTMB=$P($G(^PRC(440,PRCTMP,3)),U,4) ; "RTN","PRCHLO6",64,0) S PRCDT=PRCDT_PRCTMB_U ;VENDOR FMS CODE "RTN","PRCHLO6",65,0) S PRCTMB=$P($G(^PRC(440,PRCTMP,3)),U,5) "RTN","PRCHLO6",66,0) S PRCDT=PRCDT_PRCTMB_U ;VENDOR ALT-ADDR-IND "RTN","PRCHLO6",67,0) S PRCTMB=$P($G(^PRC(440,PRCTMP,7)),U,12) "RTN","PRCHLO6",68,0) S PRCDT=PRCDT_PRCTMB_U ;VENDOR D & B "RTN","PRCHLO6",69,0) S PRCDT=PRCDT_$P(PRCND,U,10)_U ;VENDOR CONTRACT NUMBER "RTN","PRCHLO6",70,0) S PRCDT=PRCDT_$P(PRCND,U,1)_U ;CONTROL POINT "RTN","PRCHLO6",71,0) S PRCDT=PRCDT_$P(PRCND,U,3)_U ;COST CENTER "RTN","PRCHLO6",72,0) S PRCDT=PRCDT_$P(PRCND,U,6)_U ;BOC1 "RTN","PRCHLO6",73,0) S PRCDT=PRCDT_$P(PRCND,U,7)_U ;BOC1 $ AMOUNT "RTN","PRCHLO6",74,0) S PRCDT=PRCDT_$P(PRCND,U,2)_U ;ACCOUNTING DATA "RTN","PRCHLO6",75,0) S PRCDT=PRCDT_$P(PRCND,U,12)_U ;FCP/PRJ "RTN","PRCHLO6",76,0) S X=$P(PRCND,U,11),PRCDT=PRCDT_$S(X>0:$E(X+17000000,1,4),1:"")_U ;BBFY "RTN","PRCHLO6",77,0) S PRCND=$G(^PRCS(410,PRCIEN,4)) ;NODE 4 "RTN","PRCHLO6",78,0) S PRCDT=PRCDT_$P(PRCND,U,1)_U ;COMMITTED (EST.) COST "RTN","PRCHLO6",79,0) S X=$P(PRCND,U,2),PRCDT=PRCDT_$S(X>0:$$FMTE^XLFDT($P(X,".")),1:"")_U ;DATE COMMITTED "RTN","PRCHLO6",80,0) S PRCDT=PRCDT_$P(PRCND,U,3)_U ;OBLIGATED ACTUAL COST "RTN","PRCHLO6",81,0) S X=$P(PRCND,U,4),PRCDT=PRCDT_$S(X>0:$$FMTE^XLFDT($P(X,".")),1:"")_U ;DATE OBLIGATED "RTN","PRCHLO6",82,0) S PRCDT=PRCDT_$P(PRCND,U,5)_U ;PO / OBLIGATION NO "RTN","PRCHLO6",83,0) S PRCDT=PRCDT_$P(PRCND,U,6)_U ;ADJUSTMENT AMOUNT "RTN","PRCHLO6",84,0) S X=$P(PRCND,U,7),PRCDT=PRCDT_$S(X>0:$$FMTE^XLFDT($P(X,".")),1:"")_U ;DATE OBL ADJUSTED "RTN","PRCHLO6",85,0) S PRCDT=PRCDT_$P(PRCND,U,8)_U ;TRANSACTION AMOUNT "RTN","PRCHLO6",86,0) S PRCDUZ=$P(PRCND,U,9),PRCTMP=$P($G(^VA(200,+PRCDUZ,0)),U) "RTN","PRCHLO6",87,0) S PRCDT=PRCDT_PRCDUZ_U ;OBLIGATED BY DUZ "RTN","PRCHLO6",88,0) S PRCDT=PRCDT_PRCTMP_U ;OBLIGATED BY NAME "RTN","PRCHLO6",89,0) S PRCDUZ=$P($G(^VA(200,+PRCDUZ,5)),U) "RTN","PRCHLO6",90,0) S PRCTMP=$S(PRCDUZ="":"",1:$$GET1^DIQ(49,+PRCDUZ_",",.01)) "RTN","PRCHLO6",91,0) S PRCDT=PRCDT_PRCDUZ_U_PRCTMP_U ;OBLIGATED SERVICE INT/EXT "RTN","PRCHLO6",92,0) S X=$P(PRCND,U,13),PRCDT=PRCDT_$S(X>0:$$FMTE^XLFDT($P(X,".")),1:"")_U ;OBL VAL CODE DATE/TIME "RTN","PRCHLO6",93,0) S PRCND=$G(^PRCS(410,PRCIEN,7)) ;NODE 7 "RTN","PRCHLO6",94,0) S PRCDUZ=$P(PRCND,U,1),PRCTMP=$P($G(^VA(200,+PRCDUZ,0)),U) "RTN","PRCHLO6",95,0) S PRCDT=PRCDT_PRCDUZ_U ;REQUESTOR DUZ "RTN","PRCHLO6",96,0) S PRCDT=PRCDT_PRCTMP_U ;REQUESTOR NAME "RTN","PRCHLO6",97,0) S PRCDUZ=$P($G(^VA(200,+PRCDUZ,5)),U) "RTN","PRCHLO6",98,0) S PRCTMP=$S(PRCDUZ="":"",1:$$GET1^DIQ(49,+PRCDUZ_",",.01)) "RTN","PRCHLO6",99,0) S PRCDT=PRCDT_PRCDUZ_U_PRCTMP_U ;REQUESTOR SERVICE INT/EXT "RTN","PRCHLO6",100,0) S PRCDT=PRCDT_$P(PRCND,U,2)_U ;REQUESTOR'S TITLE "RTN","PRCHLO6",101,0) S PRCDUZ=$P(PRCND,U,3),PRCTMP=$P($G(^VA(200,+PRCDUZ,0)),U) "RTN","PRCHLO6",102,0) S PRCDT=PRCDT_PRCDUZ_U ;APPROVING OFFICIAL DUZ "RTN","PRCHLO6",103,0) S PRCDT=PRCDT_PRCTMP_U ;APPROVING OFFICIAL NAME "RTN","PRCHLO6",104,0) S PRCDUZ=$P($G(^VA(200,+PRCDUZ,5)),U) "RTN","PRCHLO6",105,0) S PRCTMP=$S(PRCDUZ="":"",1:$$GET1^DIQ(49,+PRCDUZ_",",.01)) "RTN","PRCHLO6",106,0) S PRCDT=PRCDT_PRCDUZ_U_PRCTMP_U ;APPROVING OFFICIAL SERVICE INT/EXT "RTN","PRCHLO6",107,0) S PRCDT=PRCDT_$P(PRCND,U,4)_U ;APPROVING OFFICIAL TITLE "RTN","PRCHLO6",108,0) S X=$P(PRCND,U,5),PRCDT=PRCDT_$S(X>0:$$FMTE^XLFDT($P(X,".")),1:"")_U ;DATE SIGNED (APPROVED) "RTN","PRCHLO6",109,0) S X=$P(PRCND,U,7),PRCDT=PRCDT_$S(X>0:$$FMTE^XLFDT($P(X,".")),1:"")_U ;ES CODE DATE/TIME "RTN","PRCHLO6",110,0) S ^TMP($J,"CONTRP",PRCIEN,1)=PRCDT,PRCDT="" "RTN","PRCHLO6",111,0) S PRCTMB=8 D WORDFLD ;NODE 8 "RTN","PRCHLO6",112,0) S PRCDT=PRCDT_PRCTMP_U ;JUSTIFICATION "RTN","PRCHLO6",113,0) S ^TMP($J,"CONTRP",PRCIEN,2)=PRCDT,PRCDT="" "RTN","PRCHLO6",114,0) S PRCND=$G(^PRCS(410,PRCIEN,11)) ;NODE 11 "RTN","PRCHLO6",115,0) S PRCTMP=$P(PRCND,U) I PRCTMP'="" D "RTN","PRCHLO6",116,0) . S PRCTMB=$P(PRCTMP,";",2),PRCTMP=$P(PRCTMP,";") "RTN","PRCHLO6",117,0) . S PRCTMP=$P($G(@("^"_PRCTMB_+PRCTMP_",0)")),U) "RTN","PRCHLO6",118,0) S PRCDT=PRCDT_PRCTMP_U ;SORT GROUP EXTERNAL "RTN","PRCHLO6",119,0) S PRCND=$G(^PRCS(410,PRCIEN,10)) ;NODE 10 "RTN","PRCHLO6",120,0) S PRCTMP=$P(PRCND,U,3),PRCTMB=$P($G(^PRC(442,+PRCTMP,0)),U) "RTN","PRCHLO6",121,0) S PRCDT=PRCDT_PRCTMP_U ;STATION NO - P.O.NO IEN "RTN","PRCHLO6",122,0) S PRCDT=PRCDT_PRCTMB_U ;STATION NO - P.O.NO EXT "RTN","PRCHLO6",123,0) S PRCDT=PRCDT_$$PODATE(PRCTMP)_U ;PO DATE "RTN","PRCHLO6",124,0) S D0=PRCIEN D STATUS^PRCSES "RTN","PRCHLO6",125,0) S PRCDT=PRCDT_X_U ;STATUS "RTN","PRCHLO6",126,0) S PRCTMB="CO" D WORDFLD ;NODE CO "RTN","PRCHLO6",127,0) S PRCDT=PRCDT_PRCTMP_U ;COMMENTS "RTN","PRCHLO6",128,0) S ^TMP($J,"CONTRP",PRCIEN,3)=PRCDT,PRCDT="" "RTN","PRCHLO6",129,0) S PRCTMB=13 D WORDFLD ;NODE 13 "RTN","PRCHLO6",130,0) S PRCDT=PRCDT_PRCTMP ;REASON FOR RETURN "RTN","PRCHLO6",131,0) S ^TMP($J,"CONTRP",PRCIEN,4)=PRCDT "RTN","PRCHLO6",132,0) D GET4104 "RTN","PRCHLO6",133,0) Q "RTN","PRCHLO6",134,0) GET4104 ; GET DATA FROM SUBFILE 410.04 "RTN","PRCHLO6",135,0) N PRCX S PRCX=$P(^PRCS(410,PRCIEN,0),U)_U_PRCIEN_U_$P(^(0),U,5)_U "RTN","PRCHLO6",136,0) S X=$P($G(^PRCS(410,PRCIEN,10)),U,3),PRCX=PRCX_$S(X>0:X_U_$P($G(^PRC(442,X,0)),U),1:U)_U_$$PODATE(X)_U_MNTHYR_U "RTN","PRCHLO6",137,0) N PRCTMI "RTN","PRCHLO6",138,0) S PRCTMI=0 F S PRCTMI=$O(^PRCS(410,PRCIEN,12,PRCTMI)) Q:'PRCTMI D "RTN","PRCHLO6",139,0) . S PRCDT=PRCX "RTN","PRCHLO6",140,0) . S PRCND=$G(^PRCS(410,PRCIEN,12,PRCTMI,0)) "RTN","PRCHLO6",141,0) . S PRCDT=PRCDT_$P($G(^PRCS(410.4,+$P(PRCND,U,1),0)),U)_U ;SUB-CONTROL POINT "RTN","PRCHLO6",142,0) . S PRCDT=PRCDT_$P(PRCND,U,2)_U ;AMOUNT "RTN","PRCHLO6",143,0) . S PRCTMB=$$GET1^DIQ(410.04,PRCTMI_","_PRCIEN_",",2) "RTN","PRCHLO6",144,0) . S PRCDT=PRCDT_PRCTMB ;SCP AMOUNT "RTN","PRCHLO6",145,0) . S ^TMP($J,"SUBCP",PRCIEN,PRCTMI)=PRCDT "RTN","PRCHLO6",146,0) Q "RTN","PRCHLO6",147,0) WORDFLD ; PROCESS WORD FIELD "RTN","PRCHLO6",148,0) N PRCTMI,PRCTMJ "RTN","PRCHLO6",149,0) S PRCTMI=$P($G(^PRCS(410,PRCIEN,PRCTMB,0)),U,3),PRCTMP="" "RTN","PRCHLO6",150,0) I PRCTMI D "RTN","PRCHLO6",151,0) . F PRCTMI=1:1:PRCTMI D "RTN","PRCHLO6",152,0) .. S PRCTMJ=$G(^PRCS(410,PRCIEN,PRCTMB,PRCTMI,0))_" " "RTN","PRCHLO6",153,0) .. I $F(PRCTMJ,"^") S PRCTMJ=$TR(PRCTMJ,"^","*") ;CONVERT ^ TO * "RTN","PRCHLO6",154,0) .. S PRCTMP=PRCTMP_PRCTMJ "RTN","PRCHLO6",155,0) Q "RTN","PRCHLO6",156,0) ; "RTN","PRCHLO6",157,0) GET424 ; "RTN","PRCHLO6",158,0) S U="^" "RTN","PRCHLO6",159,0) N PRCND,PRCIEN,PRCDT,PRCTMP,PRCTMB,PRCC,X "RTN","PRCHLO6",160,0) ; loop through file 424, "C" Cross Reference "RTN","PRCHLO6",161,0) S PRCC=0 "RTN","PRCHLO6",162,0) F S PRCC=$O(^PRC(424,"C",PRCC)) Q:'PRCC D "RTN","PRCHLO6",163,0) . I $D(^TMP($J,"POMAST",PRCC)) D DAT424 "RTN","PRCHLO6",164,0) D GET4241 "RTN","PRCHLO6",165,0) Q "RTN","PRCHLO6",166,0) DAT424 ; "RTN","PRCHLO6",167,0) N PRCPOID "RTN","PRCHLO6",168,0) S PRCIEN=0 "RTN","PRCHLO6",169,0) F S PRCIEN=$O(^PRC(424,"C",PRCC,PRCIEN)) Q:'PRCIEN D "RTN","PRCHLO6",170,0) . S PRCDT="" "RTN","PRCHLO6",171,0) . S PRCND=$G(^PRC(424,PRCIEN,0)) ;NODE 0 "RTN","PRCHLO6",172,0) . S (PRCPOID,X,Y)=$P(PRCND,U,2),PRCDT=PRCDT_X_U ;OBLIGATION INT "RTN","PRCHLO6",173,0) . S X=$S(X>0:$P($G(^PRC(442,X,0)),U),1:""),PRCDT=PRCDT_X_U ; OBL EXT "RTN","PRCHLO6",174,0) . S PRCDT=PRCDT_$$PODATE(PRCPOID)_U ;PO DATE "RTN","PRCHLO6",175,0) . S PRCDT=PRCDT_MNTHYR_U ;Month,Year of extract "RTN","PRCHLO6",176,0) . S PRCDT=PRCDT_$P(X,"-")_U ;STATION # "RTN","PRCHLO6",177,0) . S PRCDT=PRCDT_$P(PRCND,U,1)_U ;AUTHORIZATION # "RTN","PRCHLO6",178,0) . S PRCDT=PRCDT_$$GET1^DIQ(424,PRCIEN_",",.03)_U ;TRANSACTION TYPE "RTN","PRCHLO6",179,0) . S PRCDT=PRCDT_$P(PRCND,U,4)_U ;LIQUIDATION AMOUNT "RTN","PRCHLO6",180,0) . S PRCDT=PRCDT_$P(PRCND,U,5)_U ;AUTHORIZATION BALANCE "RTN","PRCHLO6",181,0) . S PRCDT=PRCDT_$P(PRCND,U,6)_U ;OBLIGATION AMOUNT "RTN","PRCHLO6",182,0) . S X=$P(PRCND,U,7),PRCDT=PRCDT_$S(X>0:$$FMTE^XLFDT($P(X,".")),1:"")_U ;DATE/TIME "RTN","PRCHLO6",183,0) . S PRCDUZ=$P(PRCND,U,8),PRCTMP=$P($G(^VA(200,+PRCDUZ,0)),U) "RTN","PRCHLO6",184,0) . S PRCDT=PRCDT_PRCDUZ_U ;USER DUZ "RTN","PRCHLO6",185,0) . S PRCDT=PRCDT_PRCTMP_U ;USER NAME "RTN","PRCHLO6",186,0) . S PRCDUZ=$P($G(^VA(200,+PRCDUZ,5)),U) "RTN","PRCHLO6",187,0) . S PRCTMP=$S(PRCDUZ="":"",1:$$GET1^DIQ(49,+PRCDUZ_",",.01)) "RTN","PRCHLO6",188,0) . S PRCDT=PRCDT_PRCDUZ_U_PRCTMP_U ;USER SERVICE INT/EXT "RTN","PRCHLO6",189,0) . S PRCDT=PRCDT_$$GET1^DIQ(424,PRCIEN_",",.09)_U ;COMPLETED FLAG "RTN","PRCHLO6",190,0) . S PRCDT=PRCDT_$P(PRCND,U,10)_U ;REFERENCE "RTN","PRCHLO6",191,0) . S PRCDT=PRCDT_$P(PRCND,U,11)_U ;LAST SEQUENCE USED "RTN","PRCHLO6",192,0) . S PRCDT=PRCDT_$P(PRCND,U,12)_U ;AUTHORIZATION AMOUNT "RTN","PRCHLO6",193,0) . S PRCDT=PRCDT_$P(PRCND,U,13)_U ;ORIGINAL AUTH. AMOUNT "RTN","PRCHLO6",194,0) . S PRCDUZ=$P(PRCND,U,14),PRCTMP=$P($G(^VA(200,+PRCDUZ,0)),U) "RTN","PRCHLO6",195,0) . S PRCDT=PRCDT_PRCDUZ_U ;LAST EDITED BY DUZ "RTN","PRCHLO6",196,0) . S PRCDT=PRCDT_PRCTMP_U ;LAST EDITED BY NAME "RTN","PRCHLO6",197,0) . S PRCDUZ=$P($G(^VA(200,+PRCDUZ,5)),U) "RTN","PRCHLO6",198,0) . S PRCTMP=$S(PRCDUZ="":"",1:$$GET1^DIQ(49,+PRCDUZ_",",.01)) "RTN","PRCHLO6",199,0) . S PRCDT=PRCDT_PRCDUZ_U_PRCTMP_U ;LAST EDITED BY SERVICE INT/EXT "RTN","PRCHLO6",200,0) . S PRCTMP=$P(PRCND,U,15),PRCTMP=$P($G(^PRCS(410,+PRCTMP,0)),U) "RTN","PRCHLO6",201,0) . S PRCDT=PRCDT_$P(PRCND,U,15)_U ;CPA POINTER IEN "RTN","PRCHLO6",202,0) . S PRCDT=PRCDT_PRCTMP_U ;CPA POINTER EXT "RTN","PRCHLO6",203,0) . S PRCND=$G(^PRC(424,PRCIEN,1)) ;NODE 1 "RTN","PRCHLO6",204,0) . S PRCDT=PRCDT_$P(PRCND,U,1)_U ;COMMENTS "RTN","PRCHLO6",205,0) . S PRCND=$G(^PRC(424,PRCIEN,2)) ;NODE 2 "RTN","PRCHLO6",206,0) . S PRCDT=PRCDT_$P(PRCND,U,2) ;INTERFACE ID "RTN","PRCHLO6",207,0) . S ^TMP($J,"DR1358",PRCIEN,1)=PRCDT "RTN","PRCHLO6",208,0) Q "RTN","PRCHLO6",209,0) GET4241 ; "RTN","PRCHLO6",210,0) ; loop through file 424.1 "RTN","PRCHLO6",211,0) S PRCC=0 "RTN","PRCHLO6",212,0) F S PRCC=$O(^PRC(424.1,"C",PRCC)) Q:'PRCC D "RTN","PRCHLO6",213,0) . I $D(^TMP($J,"DR1358",PRCC)) D DAT4241 "RTN","PRCHLO6",214,0) Q "RTN","PRCHLO6",215,0) DAT4241 ; "RTN","PRCHLO6",216,0) N Y,PRCSTN "RTN","PRCHLO6",217,0) S PRCIEN=0 F S PRCIEN=$O(^PRC(424.1,"C",PRCC,PRCIEN)) Q:'PRCIEN D "RTN","PRCHLO6",218,0) . S PRCDT="" "RTN","PRCHLO6",219,0) . S PRCND=$G(^PRC(424.1,PRCIEN,0)) ;NODE 0 "RTN","PRCHLO6",220,0) . S X=$P(PRCND,U,2) "RTN","PRCHLO6",221,0) . S (X,PRCPOID)=$P($G(^PRC(424,+X,0)),U,2),PRCDT=PRCDT_X_U ;PO# INT "RTN","PRCHLO6",222,0) . S X=$S(X>0:$P($G(^PRC(442,X,0)),U),1:""),PRCDT=PRCDT_X_U ;PO# EXT "RTN","PRCHLO6",223,0) . S PRCSTN=$P(X,"-") S:PRCPOID="" PRCPOID=PRCIEN "RTN","PRCHLO6",224,0) . S PRCDT=PRCDT_$$PODATE(PRCPOID)_U ;PO DATE "RTN","PRCHLO6",225,0) . S PRCDT=PRCDT_MNTHYR_U ;Month,Year of extract "RTN","PRCHLO6",226,0) . S PRCDT=PRCDT_PRCSTN_U ;STATION "RTN","PRCHLO6",227,0) . S PRCDT=PRCDT_$P(PRCND,U,1)_U ;BILL NUMBER "RTN","PRCHLO6",228,0) . S PRCDT=PRCDT_$$GET1^DIQ(424.1,PRCIEN_",",.011)_U ;RECORD TYPE "RTN","PRCHLO6",229,0) . S PRCTMP=$P(PRCND,U,2),PRCTMP=$P($G(^PRC(424,+PRCTMP,0)),U) "RTN","PRCHLO6",230,0) . S PRCDT=PRCDT_$P(PRCND,U,2)_U ;AUTH. POINTER IEN "RTN","PRCHLO6",231,0) . S PRCDT=PRCDT_PRCTMP_U ;AUTH. POINTER EXT "RTN","PRCHLO6",232,0) . S PRCDT=PRCDT_$P(PRCND,U,3)_U ;AUTH. AMOUNT "RTN","PRCHLO6",233,0) . S X=$P(PRCND,U,4),PRCDT=PRCDT_$S(X>0:$$FMTE^XLFDT($P(X,".")),1:"")_U ;DATE/TIME "RTN","PRCHLO6",234,0) . S PRCDUZ=$P(PRCND,U,5),PRCTMP=$P($G(^VA(200,+PRCDUZ,0)),U) "RTN","PRCHLO6",235,0) . S PRCDT=PRCDT_PRCDUZ_U ;USER DUZ "RTN","PRCHLO6",236,0) . S PRCDT=PRCDT_PRCTMP_U ;USER NAME "RTN","PRCHLO6",237,0) . S PRCDUZ=$P($G(^VA(200,+PRCDUZ,5)),U) "RTN","PRCHLO6",238,0) . S PRCTMP=$S(PRCDUZ="":"",1:$$GET1^DIQ(49,+PRCDUZ_",",.01)) "RTN","PRCHLO6",239,0) . S PRCDT=PRCDT_PRCDUZ_U_PRCTMP_U ;USER SERVICE INT/EXT "RTN","PRCHLO6",240,0) . S PRCDT=PRCDT_$P(PRCND,U,6)_U ;VENDOR INVOICE NUMBER "RTN","PRCHLO6",241,0) . S PRCDT=PRCDT_$$GET1^DIQ(424.1,PRCIEN_",",.07)_U ;FINAL BILL "RTN","PRCHLO6",242,0) . S PRCDT=PRCDT_$P(PRCND,U,8)_U ;REFERENCE "RTN","PRCHLO6",243,0) . S PRCDUZ=$P(PRCND,U,10),PRCTMP=$P($G(^VA(200,+PRCDUZ,0)),U) "RTN","PRCHLO6",244,0) . S PRCDT=PRCDT_PRCDUZ_U ;LAST EDITED BY DUZ "RTN","PRCHLO6",245,0) . S PRCDT=PRCDT_PRCTMP_U ;LAST EDITED BY NAME "RTN","PRCHLO6",246,0) . S PRCDUZ=$P($G(^VA(200,+PRCDUZ,5)),U) "RTN","PRCHLO6",247,0) . S PRCTMP=$S(PRCDUZ="":"",1:$$GET1^DIQ(49,+PRCDUZ_",",.01)) "RTN","PRCHLO6",248,0) . S PRCDT=PRCDT_PRCDUZ_U_PRCTMP_U ;LAST EDITED BY SERVICE INT/EXT "RTN","PRCHLO6",249,0) . S PRCND=$G(^PRC(424.1,PRCIEN,1)) ;NODE 1 "RTN","PRCHLO6",250,0) . S PRCDT=PRCDT_$P(PRCND,U,1) ;DESCRIPTION "RTN","PRCHLO6",251,0) . S ^TMP($J,"AD1358",PRCIEN,1)=PRCDT "RTN","PRCHLO6",252,0) Q "RTN","PRCHLO6",253,0) PODATE(PRCPOIEN) ;input PO's ien, output external form PO Date "RTN","PRCHLO6",254,0) N X "RTN","PRCHLO6",255,0) S X=$S(PRCPOIEN>0:$P($G(^PRC(442,PRCPOIEN,1)),U,15),1:"") "RTN","PRCHLO6",256,0) S:X'="" X=$$FMTE^XLFDT(X,"D") "RTN","PRCHLO6",257,0) Q X "RTN","PRCPLO4") 0^12^B69580377^B35020662 "RTN","PRCPLO4",1,0) PRCPLO4 ;WOIFO/DAP- Option to allow users to set CLRS parameters ; 10/19/06 8:44am "RTN","PRCPLO4",2,0) ;;5.1;IFCAP;**83,98,130**;Oct 20, 2000;Build 25 "RTN","PRCPLO4",3,0) ;Per VHA Directive 2004-038, this routine should not be modified. "RTN","PRCPLO4",4,0) ; "RTN","PRCPLO4",5,0) ENT ;This allows users to enter new values for the parameters associated "RTN","PRCPLO4",6,0) ;with the Clinical Logistics Report Server by prompting them for "RTN","PRCPLO4",7,0) ;a new value for each parameter after presenting the current value. "RTN","PRCPLO4",8,0) ;Values are screened for validity and errors in setting the parameters "RTN","PRCPLO4",9,0) ;are returned to the screen. IA #2263 can be referenced for further "RTN","PRCPLO4",10,0) ;information on the ^XPAR calls utilized here. "RTN","PRCPLO4",11,0) ; "RTN","PRCPLO4",12,0) N PRCP1,PRCP2,PRCP3,PRCP4,PRCP5,PRCP6,PRCPW,PRCPU,PRCPV,PRCPX,PRCPY,PRCPZ,ERR "RTN","PRCPLO4",13,0) D PRR I ERR Q "RTN","PRCPLO4",14,0) D PGR I ERR Q "RTN","PRCPLO4",15,0) D PIR I ERR Q "RTN","PRCPLO4",16,0) D PED I ERR Q "RTN","PRCPLO4",17,0) ; "RTN","PRCPLO4",18,0) ;*98 Added logic for modification of PRC CLRS ADDRESS and "RTN","PRCPLO4",19,0) ;PRC CLRS OUTLOOK MAILGROUP parameters "RTN","PRCPLO4",20,0) ; "RTN","PRCPLO4",21,0) D PAD I ERR Q "RTN","PRCPLO4",22,0) D POG I ERR Q "RTN","PRCPLO4",23,0) ; PRC*5.1*130 begin "RTN","PRCPLO4",24,0) ; Added user name, password, and Regional Acquisition Center "RTN","PRCPLO4",25,0) D USN I ERR Q "RTN","PRCPLO4",26,0) D PSW I ERR Q "RTN","PRCPLO4",27,0) D RAC I ERR Q "RTN","PRCPLO4",28,0) ; PRC*5.1*130 end "RTN","PRCPLO4",29,0) Q "RTN","PRCPLO4",30,0) ; "RTN","PRCPLO4",31,0) PRR ;Provide current value of and then prompt to modify the PRCPLO REPORT RANGE parameter "RTN","PRCPLO4",32,0) ; "RTN","PRCPLO4",33,0) N DIR,DIROUT,DIRUT,DUOUT,DTOUT,X,Y "RTN","PRCPLO4",34,0) S ERR=0 "RTN","PRCPLO4",35,0) S DIR(0)="NOA^0:999",DIR("A")="Stock On Hand Report Range: " "RTN","PRCPLO4",36,0) S PRCP1=$$GET^XPAR("SYS","PRCPLO REPORT RANGE",1,"Q") "RTN","PRCPLO4",37,0) I PRCP1'="" S DIR("B")=PRCP1 "RTN","PRCPLO4",38,0) S DIR("?")="Please enter a number between 0 and 999 with no decimal digits" "RTN","PRCPLO4",39,0) D ^DIR I $D(DUOUT)!$D(DTOUT) S ERR=1 Q "RTN","PRCPLO4",40,0) I PRCP1=X Q "RTN","PRCPLO4",41,0) I X'="@" S PRCP1=X "RTN","PRCPLO4",42,0) I X="@" D EN^DDIOL("Deletions not allowed") G PRR "RTN","PRCPLO4",43,0) K DIR,DIROUT,DIRUT,DUOUT,DTOUT,X,Y "RTN","PRCPLO4",44,0) D EN^XPAR("SYS","PRCPLO REPORT RANGE",1,PRCP1,.PRCPX) "RTN","PRCPLO4",45,0) I PRCPX=0 W ! D EN^DDIOL("Stock on Hand Report Range successfully set to "_PRCP1) "RTN","PRCPLO4",46,0) I PRCPX'=0 W ! D EN^DDIOL("Error while trying to edit the Stock on Hand Report Range:") W ! D EN^DDIOL($P(PRCPX,"^",2)) "RTN","PRCPLO4",47,0) Q "RTN","PRCPLO4",48,0) ; "RTN","PRCPLO4",49,0) PIR ;Provide current value of and then prompt to modify the PRCPLO INACTIVITY RANGE parameter "RTN","PRCPLO4",50,0) ; "RTN","PRCPLO4",51,0) N DIR,DIROUT,DIRUT,DUOUT,DTOUT,X,Y "RTN","PRCPLO4",52,0) S ERR=0 "RTN","PRCPLO4",53,0) S DIR(0)="NOA^0:999",DIR("A")="Stock Status Report Inactivity Range: " "RTN","PRCPLO4",54,0) S PRCP2=$$GET^XPAR("SYS","PRCPLO INACTIVITY RANGE",1,"Q") "RTN","PRCPLO4",55,0) I PRCP2'="" S DIR("B")=PRCP2 "RTN","PRCPLO4",56,0) S DIR("?")="Please enter a number between 0 and 999 with no decimal digits" "RTN","PRCPLO4",57,0) D ^DIR I $D(DUOUT)!$D(DTOUT) S ERR=1 Q "RTN","PRCPLO4",58,0) I PRCP2=X Q "RTN","PRCPLO4",59,0) I X'="@" S PRCP2=X "RTN","PRCPLO4",60,0) I X="@" D EN^DDIOL("Deletions not allowed") G PIR "RTN","PRCPLO4",61,0) K DIR,DIROUT,DIRUT,DUOUT,DTOUT,X,Y "RTN","PRCPLO4",62,0) D EN^XPAR("SYS","PRCPLO INACTIVITY RANGE",1,PRCP2,.PRCPY) "RTN","PRCPLO4",63,0) I PRCPY=0 W ! D EN^DDIOL("Stock Status Report Inactivity Range successfully set to "_PRCP2) "RTN","PRCPLO4",64,0) I PRCPY'=0 W ! D EN^DDIOL("Error while trying to edit the Stock Status Report Inactivity Range:") W ! D EN^DDIOL($P(PRCPY,"^",2)) "RTN","PRCPLO4",65,0) Q "RTN","PRCPLO4",66,0) ; "RTN","PRCPLO4",67,0) PGR ;Provide current value of and then prompt to modify the PRCPLO GREATER THAN RANGE parameter "RTN","PRCPLO4",68,0) ; "RTN","PRCPLO4",69,0) N DIR,DIROUT,DIRUT,DUOUT,DTOUT,X,Y "RTN","PRCPLO4",70,0) S ERR=0 "RTN","PRCPLO4",71,0) S DIR(0)="NOA^0:999",DIR("A")="Stock On Hand Report Greater Than Range: " "RTN","PRCPLO4",72,0) S PRCP3=$$GET^XPAR("SYS","PRCPLO GREATER THAN RANGE",1,"Q") "RTN","PRCPLO4",73,0) I PRCP3'="" S DIR("B")=PRCP3 "RTN","PRCPLO4",74,0) S DIR("?")="Please enter a number between 0 and 999 with no decimal digits" "RTN","PRCPLO4",75,0) D ^DIR I $D(DUOUT)!$D(DTOUT) S ERR=1 Q "RTN","PRCPLO4",76,0) I PRCP3=X Q "RTN","PRCPLO4",77,0) I X'="@" S PRCP3=X "RTN","PRCPLO4",78,0) I X="@" D EN^DDIOL("Deletions not allowed") G PGR "RTN","PRCPLO4",79,0) K DIR,DIROUT,DIRUT,DUOUT,DTOUT,X,Y "RTN","PRCPLO4",80,0) D EN^XPAR("SYS","PRCPLO GREATER THAN RANGE",1,PRCP3,.PRCPZ) "RTN","PRCPLO4",81,0) I PRCPZ=0 W ! D EN^DDIOL("Stock on Hand Report Greater Than Range successfully set to "_PRCP3) "RTN","PRCPLO4",82,0) I PRCPZ'=0 W ! D EN^DDIOL("Error while trying to edit the Stock on Hand Report Greater Than Range:") W ! D EN^DDIOL($P(PRCPZ,"^",2)) "RTN","PRCPLO4",83,0) ; "RTN","PRCPLO4",84,0) Q "RTN","PRCPLO4",85,0) ; "RTN","PRCPLO4",86,0) PED ;Provide current value of and then prompt to modify the PRCPLO EXTRACT DIRECTORY parameter "RTN","PRCPLO4",87,0) ; "RTN","PRCPLO4",88,0) N DIR,DIROUT,DIRUT,DUOUT,DTOUT,X,Y "RTN","PRCPLO4",89,0) S ERR=0 "RTN","PRCPLO4",90,0) S DIR(0)="FOr^1:245",DIR("A")="CLRS Extract Directory" "RTN","PRCPLO4",91,0) S PRCP4=$$GET^XPAR("SYS","PRCPLO EXTRACT DIRECTORY",1,"Q") "RTN","PRCPLO4",92,0) I PRCP4'="" S DIR("B")=PRCP4 "RTN","PRCPLO4",93,0) S DIR("?")="Please enter free text character string between 1 and 245 characters" "RTN","PRCPLO4",94,0) D ^DIR I $D(DUOUT)!$D(DTOUT) S ERR=1 Q "RTN","PRCPLO4",95,0) I PRCP4=X Q "RTN","PRCPLO4",96,0) I X'="@" S PRCP4=X "RTN","PRCPLO4",97,0) I X="@" D EN^DDIOL("Deletions not allowed") G PED "RTN","PRCPLO4",98,0) K DIR,DIROUT,DIRUT,DUOUT,DTOUT,X,Y "RTN","PRCPLO4",99,0) D EN^XPAR("SYS","PRCPLO EXTRACT DIRECTORY",1,PRCP4,.PRCPV) "RTN","PRCPLO4",100,0) I PRCP4="@" Q "RTN","PRCPLO4",101,0) I PRCPV=0 W ! D EN^DDIOL("CLRS Extract Directory successfully set to "_PRCP4) "RTN","PRCPLO4",102,0) I PRCPV'=0 W ! D EN^DDIOL("Error while trying to edit the CLRS Extract Directory:") W ! D EN^DDIOL($P(PRCPV,"^",2)) "RTN","PRCPLO4",103,0) ; "RTN","PRCPLO4",104,0) Q "RTN","PRCPLO4",105,0) ; "RTN","PRCPLO4",106,0) PAD ;Provide current value of and then prompt to modify the PRC CLRS ADDRESS parameter "RTN","PRCPLO4",107,0) ; "RTN","PRCPLO4",108,0) N DIR,DIROUT,DIRUT,DUOUT,DTOUT,X,Y "RTN","PRCPLO4",109,0) S ERR=0 "RTN","PRCPLO4",110,0) S DIR(0)="FOr^1:245",DIR("A")="CLRS Address" "RTN","PRCPLO4",111,0) S PRCP5=$$GET^XPAR("SYS","PRC CLRS ADDRESS",1,"Q") "RTN","PRCPLO4",112,0) I PRCP5'="" S DIR("B")=PRCP5 "RTN","PRCPLO4",113,0) S DIR("?")="Please enter free text character string between 1 and 245 characters" "RTN","PRCPLO4",114,0) D ^DIR I $D(DUOUT)!$D(DTOUT) S ERR=1 Q "RTN","PRCPLO4",115,0) I PRCP5=X Q "RTN","PRCPLO4",116,0) S PRCP5=X "RTN","PRCPLO4",117,0) K DIR,DIROUT,DIRUT,DUOUT,DTOUT,X,Y "RTN","PRCPLO4",118,0) D EN^XPAR("SYS","PRC CLRS ADDRESS",1,PRCP5,.PRCPW) "RTN","PRCPLO4",119,0) I PRCP5="@" D EN^DDIOL(" ") Q "RTN","PRCPLO4",120,0) I PRCPW=0 W ! D EN^DDIOL("CLRS Address successfully set to "_PRCP5) "RTN","PRCPLO4",121,0) I PRCPW'=0 W ! D EN^DDIOL("Error while trying to edit the CLRS Address:") W ! D EN^DDIOL($P(PRCPW,"^",2)) "RTN","PRCPLO4",122,0) ; "RTN","PRCPLO4",123,0) Q "RTN","PRCPLO4",124,0) ; "RTN","PRCPLO4",125,0) POG ;Provide current value of and then prompt to modify the PRC CLRS OUTLOOK MAILGROUP parameter "RTN","PRCPLO4",126,0) ; "RTN","PRCPLO4",127,0) N DIR,DIROUT,DIRUT,DUOUT,DTOUT,X,Y "RTN","PRCPLO4",128,0) S ERR=0 "RTN","PRCPLO4",129,0) S DIR(0)="FOr^1:245",DIR("A")="CLRS Outlook Mail Group" "RTN","PRCPLO4",130,0) S PRCP6=$$GET^XPAR("SYS","PRC CLRS OUTLOOK MAILGROUP",1,"Q") "RTN","PRCPLO4",131,0) I PRCP6'="" S DIR("B")=PRCP6 "RTN","PRCPLO4",132,0) S DIR("?")="Please enter free text character string between 1 and 245 characters" "RTN","PRCPLO4",133,0) D ^DIR I $D(DUOUT)!$D(DTOUT) S ERR=1 Q "RTN","PRCPLO4",134,0) I PRCP6=X Q "RTN","PRCPLO4",135,0) S PRCP6=X "RTN","PRCPLO4",136,0) K DIR,DIROUT,DIRUT,DUOUT,DTOUT,X,Y "RTN","PRCPLO4",137,0) D EN^XPAR("SYS","PRC CLRS OUTLOOK MAILGROUP",1,PRCP6,.PRCPU) "RTN","PRCPLO4",138,0) I PRCP6="@" D EN^DDIOL(" ") Q "RTN","PRCPLO4",139,0) I PRCPU=0 W ! D EN^DDIOL("CLRS Outlook Mail Group successfully set to "_PRCP6) "RTN","PRCPLO4",140,0) I PRCPU'=0 W ! D EN^DDIOL("Error while trying to edit the CLRS Outlook Mail Group:") W ! D EN^DDIOL($P(PRCPU,"^",2)) "RTN","PRCPLO4",141,0) ; "RTN","PRCPLO4",142,0) Q "RTN","PRCPLO4",143,0) ; PRC*5.1*130 begin "RTN","PRCPLO4",144,0) USN ;Enter User Name for CLRS Report Server Login "RTN","PRCPLO4",145,0) ; "RTN","PRCPLO4",146,0) N DIR,DIROUT,DIRUT,DUOUT,DTOUT,X,Y "RTN","PRCPLO4",147,0) S ERR=0 "RTN","PRCPLO4",148,0) S DIR(0)="FOA^1:30",DIR("A")="User Name for CLRS Report Server Login: " "RTN","PRCPLO4",149,0) S PRCP6=$$GET^XPAR("SYS","PRCPLO USER NAME",1,"Q") "RTN","PRCPLO4",150,0) S PRCP6=$$DECRYP^XUSRB1(PRCP6) ; Decrypted value "RTN","PRCPLO4",151,0) I PRCP6'="" S DIR("B")=PRCP6 "RTN","PRCPLO4",152,0) S DIR("?")="Please enter free text character string between 1 and 30 characters" "RTN","PRCPLO4",153,0) D ^DIR I $D(DUOUT)!$D(DTOUT) S ERR=1 Q "RTN","PRCPLO4",154,0) I PRCP6=X Q "RTN","PRCPLO4",155,0) S (PRCP6,PRCP5)=X "RTN","PRCPLO4",156,0) K DIR,DIROUT,DIRUT,DUOUT,DTOUT,X,Y "RTN","PRCPLO4",157,0) I PRCP6'="@" S PRCP6=$$ENCRYP^XUSRB1(PRCP6) "RTN","PRCPLO4",158,0) D EN^XPAR("SYS","PRCPLO USER NAME",1,PRCP6,.PRCPU) "RTN","PRCPLO4",159,0) I PRCP6="@" D EN^DDIOL(" ") Q "RTN","PRCPLO4",160,0) I PRCPU=0 W ! D EN^DDIOL("PRCPLO USER NAME successfully set to "_PRCP5) "RTN","PRCPLO4",161,0) I PRCPU'=0 W ! D EN^DDIOL("Error while trying to edit the PRCPLO USER NAME:") W ! D EN^DDIOL($P(PRCPU,"^",2)) "RTN","PRCPLO4",162,0) ; "RTN","PRCPLO4",163,0) Q "RTN","PRCPLO4",164,0) PSW ; Enter Password for CLRS Report Server Login "RTN","PRCPLO4",165,0) ; "RTN","PRCPLO4",166,0) N DIR,DIROUT,DIRUT,DUOUT,DTOUT,X,Y "RTN","PRCPLO4",167,0) S ERR=0 "RTN","PRCPLO4",168,0) S DIR(0)="FOA^1:30",DIR("A")="Password for CLRS Report Server Login: " "RTN","PRCPLO4",169,0) S PRCP6=$$GET^XPAR("SYS","PRCPLO PASSWORD",1,"Q") "RTN","PRCPLO4",170,0) S PRCP6=$$DECRYP^XUSRB1(PRCP6) ; Decrypted value "RTN","PRCPLO4",171,0) I PRCP6'="" S DIR("B")=PRCP6 "RTN","PRCPLO4",172,0) S DIR("?")="Please enter free text character string between 1 and 30 characters" "RTN","PRCPLO4",173,0) D ^DIR I $D(DUOUT)!$D(DTOUT) S ERR=1 Q "RTN","PRCPLO4",174,0) I PRCP6=X Q "RTN","PRCPLO4",175,0) S (PRCP6,PRCP5)=X "RTN","PRCPLO4",176,0) K DIR,DIROUT,DIRUT,DUOUT,DTOUT,X,Y "RTN","PRCPLO4",177,0) I PRCP6'="@" S PRCP6=$$ENCRYP^XUSRB1(PRCP6) "RTN","PRCPLO4",178,0) D EN^XPAR("SYS","PRCPLO PASSWORD",1,PRCP6,.PRCPU) "RTN","PRCPLO4",179,0) I PRCP6="@" D EN^DDIOL(" ") Q "RTN","PRCPLO4",180,0) I PRCPU=0 W ! D EN^DDIOL("PRCPLO PASSWORD successfully set to "_PRCP5) "RTN","PRCPLO4",181,0) I PRCPU'=0 W ! D EN^DDIOL("Error while trying to edit the PRCPLO PASSWORD:") W ! D EN^DDIOL($P(PRCPU,"^",2)) "RTN","PRCPLO4",182,0) ; "RTN","PRCPLO4",183,0) Q "RTN","PRCPLO4",184,0) RAC ; Enter CLRS Regional Acquisition Center "RTN","PRCPLO4",185,0) ; "RTN","PRCPLO4",186,0) N DIR,DIROUT,DIRUT,DUOUT,DTOUT,X,Y "RTN","PRCPLO4",187,0) S ERR=0 "RTN","PRCPLO4",188,0) S DIR(0)="FOA^1:30",DIR("A")="CLRS Regional Acquisition Center: " "RTN","PRCPLO4",189,0) S PRCP6=$$GET^XPAR("SYS","PRCPLO REGIONAL ACQ CENTER",1,"Q") "RTN","PRCPLO4",190,0) I PRCP6'="" S DIR("B")=PRCP6 "RTN","PRCPLO4",191,0) S DIR("?")="Please enter free text character string between 1 and 30 characters" "RTN","PRCPLO4",192,0) D ^DIR I $D(DUOUT)!$D(DTOUT) S ERR=1 Q "RTN","PRCPLO4",193,0) I PRCP6=X Q "RTN","PRCPLO4",194,0) S PRCP6=X "RTN","PRCPLO4",195,0) K DIR,DIROUT,DIRUT,DUOUT,DTOUT,X,Y "RTN","PRCPLO4",196,0) D EN^XPAR("SYS","PRCPLO REGIONAL ACQ CENTER",1,PRCP6,.PRCPU) "RTN","PRCPLO4",197,0) I PRCP6="@" D EN^DDIOL(" ") Q "RTN","PRCPLO4",198,0) I PRCPU=0 W ! D EN^DDIOL("PRCPLO REGIONAL ACQ CENTER successfully set to "_PRCP6) "RTN","PRCPLO4",199,0) I PRCPU'=0 W ! D EN^DDIOL("Error while trying to edit the PRCPLO REGIONAL ACQ CENTER:") W ! D EN^DDIOL($P(PRCPU,"^",2)) "RTN","PRCPLO4",200,0) ; "RTN","PRCPLO4",201,0) Q "RTN","PRCPLO4",202,0) ; PRC*5.1*130 end "VER") 8.0^22.0 "BLD",5921,6) ^110 **END** **END**