Released PRC*5.1*151 SEQ #126 Extracted from mail message **KIDS**:PRC*5.1*151^ **INSTALL NAME** PRC*5.1*151 "BLD",6576,0) PRC*5.1*151^IFCAP^0^3101109^y "BLD",6576,1,0) ^^12^12^3100929^ "BLD",6576,1,1,0) This patch adds eight new fields to the F20 CLRS extract and the "BLD",6576,1,2,0) Control Point Activities - F20 extract validation template. "BLD",6576,1,3,0) "BLD",6576,1,4,0) The eight new fields are: "BLD",6576,1,5,0) - IEN of Authority Code "BLD",6576,1,6,0) - Authority Code "BLD",6576,1,7,0) - Authority Description "BLD",6576,1,8,0) - IEN of Subauthority Code "BLD",6576,1,9,0) - Subauthority Code "BLD",6576,1,10,0) - Subauthority Description "BLD",6576,1,11,0) - Service End Date "BLD",6576,1,12,0) - Service Start Date "BLD",6576,4,0) ^9.64PA^^ "BLD",6576,6.3) 4 "BLD",6576,"ABPKG") n "BLD",6576,"KRN",0) ^9.67PA^779.2^20 "BLD",6576,"KRN",.4,0) .4 "BLD",6576,"KRN",.4,"NM",0) ^9.68A^1^1 "BLD",6576,"KRN",.4,"NM",1,0) PRCHLO410_HDR_VALIDATE FILE #410^410^0 "BLD",6576,"KRN",.4,"NM","B","PRCHLO410_HDR_VALIDATE FILE #410",1) "BLD",6576,"KRN",.401,0) .401 "BLD",6576,"KRN",.402,0) .402 "BLD",6576,"KRN",.403,0) .403 "BLD",6576,"KRN",.5,0) .5 "BLD",6576,"KRN",.84,0) .84 "BLD",6576,"KRN",3.6,0) 3.6 "BLD",6576,"KRN",3.8,0) 3.8 "BLD",6576,"KRN",9.2,0) 9.2 "BLD",6576,"KRN",9.8,0) 9.8 "BLD",6576,"KRN",9.8,"NM",0) ^9.68A^2^2 "BLD",6576,"KRN",9.8,"NM",1,0) PRCHLO3^^0^B153453811 "BLD",6576,"KRN",9.8,"NM",2,0) PRCHLO6^^0^B136943569 "BLD",6576,"KRN",9.8,"NM","B","PRCHLO3",1) "BLD",6576,"KRN",9.8,"NM","B","PRCHLO6",2) "BLD",6576,"KRN",19,0) 19 "BLD",6576,"KRN",19.1,0) 19.1 "BLD",6576,"KRN",19.1,"NM",0) ^9.68A^1^1 "BLD",6576,"KRN",19.1,"NM",1,0) PRCSOBL^^1^ "BLD",6576,"KRN",19.1,"NM","B","PRCSOBL",1) "BLD",6576,"KRN",101,0) 101 "BLD",6576,"KRN",409.61,0) 409.61 "BLD",6576,"KRN",771,0) 771 "BLD",6576,"KRN",779.2,0) 779.2 "BLD",6576,"KRN",870,0) 870 "BLD",6576,"KRN",8989.51,0) 8989.51 "BLD",6576,"KRN",8989.52,0) 8989.52 "BLD",6576,"KRN",8994,0) 8994 "BLD",6576,"KRN","B",.4,.4) "BLD",6576,"KRN","B",.401,.401) "BLD",6576,"KRN","B",.402,.402) "BLD",6576,"KRN","B",.403,.403) "BLD",6576,"KRN","B",.5,.5) "BLD",6576,"KRN","B",.84,.84) "BLD",6576,"KRN","B",3.6,3.6) "BLD",6576,"KRN","B",3.8,3.8) "BLD",6576,"KRN","B",9.2,9.2) "BLD",6576,"KRN","B",9.8,9.8) "BLD",6576,"KRN","B",19,19) "BLD",6576,"KRN","B",19.1,19.1) "BLD",6576,"KRN","B",101,101) "BLD",6576,"KRN","B",409.61,409.61) "BLD",6576,"KRN","B",771,771) "BLD",6576,"KRN","B",779.2,779.2) "BLD",6576,"KRN","B",870,870) "BLD",6576,"KRN","B",8989.51,8989.51) "BLD",6576,"KRN","B",8989.52,8989.52) "BLD",6576,"KRN","B",8994,8994) "BLD",6576,"QDEF") ^^^^NO^^^^NO^^YES "BLD",6576,"QUES",0) ^9.62^^ "BLD",6576,"REQB",0) ^9.611^2^2 "BLD",6576,"REQB",1,0) PRC*5.1*148^1 "BLD",6576,"REQB",2,0) PRC*5.1*140^1 "BLD",6576,"REQB","B","PRC*5.1*140",2) "BLD",6576,"REQB","B","PRC*5.1*148",1) "KRN",.4,2773,-1) 0^1 "KRN",.4,2773,0) PRCHLO410_HDR_VALIDATE^3100929.0802^@^410^^@^3101103 "KRN",.4,2773,"DXS",1,9.2) S I(0,0)=$G(D0),DIP(1)=$S($D(^PRCS(410,D0,11)):^(11),1:""),D0=$P(DIP(1),U,4) S:'D0!'$D(^PRCS(410.9,+D0,0)) D0=-1 S DIP(101)=$S($D(^PRCS(410.9,D0,0)):^(0),1:"") "KRN",.4,2773,"DXS",2,9.2) S I(0,0)=$G(D0),DIP(1)=$S($D(^PRCS(410,D0,11)):^(11),1:""),D0=$P(DIP(1),U,5) S:'D0!'$D(^PRCS(410.9,+D0,0)) D0=-1 S DIP(101)=$S($D(^PRCS(410.9,D0,0)):^(0),1:"") "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;""~"1358 AUTHORITY IEN: ";C1~ "KRN",.4,2773,"F",46) S DIP(1)=$S($D(^PRCS(410,D0,11)):^(11),1:"") S X=$P(DIP(1),U,4),X=X W X K DIP;X;"";Z;"INTERNAL(#19)"~"1358 AUTHORITY CODE: ";C40;""~19;X;""~ "KRN",.4,2773,"F",47) "1358 AUTHORITY DESCRIPTION: ";C1;""~X DXS(1,9.2) S X=$P(DIP(101),U,2) S D0=I(0,0) W X K DIP;C5;"";Z;"19:.02"~"1358 SUB AUTHORITY IEN: ";C1;""~ "KRN",.4,2773,"F",48) S DIP(1)=$S($D(^PRCS(410,D0,11)):^(11),1:"") S X=$P(DIP(1),U,5),X=X W X K DIP;X;"";Z;"INTERNAL(#19.1)"~"1358 SUB AUTHORITY CODE: ";C40;""~19.1;X;""~ "KRN",.4,2773,"F",49) "1358 SUB AUTHORITY DESCRIPTION: ";C1;""~X DXS(2,9.2) S X=$P(DIP(101),U,2) S D0=I(0,0) W X K DIP;C5;"";Z;"19.1:.02"~"1358 SVC START DATE: ";C1;""~ "KRN",.4,2773,"F",50) S DIP(1)=$S($D(^PRCS(410,D0,1)):^(1),1:"") S X=$P(DIP(1),U,6),X=$P(X,".",1) S Y=X D DT K DIP;X;"";d;L18;Z;"DATE(#6)"~"1358 SVC END DATE: ";C40;""~ "KRN",.4,2773,"F",51) S DIP(1)=$S($D(^PRCS(410,D0,1)):^(1),1:"") S X=$P(DIP(1),U,7),X=$P(X,".",1) S Y=X D DT K DIP;X;"";d;L18;Z;"DATE(#6.5)"~ "KRN",.4,2773,"H") CONTROL POINT ACTIVITIES DATA "KRN",19.1,509,-1) 1^1 "KRN",19.1,509,0) PRCSOBL "MBREQ") 0 "ORD",3,19.1) 19.1;3;;;KEY^XPDTA1;KEYF1^XPDIA1;KEYE1^XPDIA1;KEYF2^XPDIA1;;KEYDEL^XPDIA1 "ORD",3,19.1,0) SECURITY KEY "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 "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) 151^3101109 "PKG",455,22,1,"PAH",1,1,0) ^^12^12^3101109 "PKG",455,22,1,"PAH",1,1,1,0) This patch adds eight new fields to the F20 CLRS extract and the "PKG",455,22,1,"PAH",1,1,2,0) Control Point Activities - F20 extract validation template. "PKG",455,22,1,"PAH",1,1,3,0) "PKG",455,22,1,"PAH",1,1,4,0) The eight new fields are: "PKG",455,22,1,"PAH",1,1,5,0) - IEN of Authority Code "PKG",455,22,1,"PAH",1,1,6,0) - Authority Code "PKG",455,22,1,"PAH",1,1,7,0) - Authority Description "PKG",455,22,1,"PAH",1,1,8,0) - IEN of Subauthority Code "PKG",455,22,1,"PAH",1,1,9,0) - Subauthority Code "PKG",455,22,1,"PAH",1,1,10,0) - Subauthority Description "PKG",455,22,1,"PAH",1,1,11,0) - Service End Date "PKG",455,22,1,"PAH",1,1,12,0) - Service Start Date "QUES","XPF1",0) Y "QUES","XPF1","??") ^D REP^XPDH "QUES","XPF1","A") Shall I write over your |FLAG| File "QUES","XPF1","B") YES "QUES","XPF1","M") D XPF1^XPDIQ "QUES","XPF2",0) Y "QUES","XPF2","??") ^D DTA^XPDH "QUES","XPF2","A") Want my data |FLAG| yours "QUES","XPF2","B") YES "QUES","XPF2","M") D XPF2^XPDIQ "QUES","XPI1",0) YO "QUES","XPI1","??") ^D INHIBIT^XPDH "QUES","XPI1","A") Want KIDS to INHIBIT LOGONs during the install "QUES","XPI1","B") NO "QUES","XPI1","M") D XPI1^XPDIQ "QUES","XPM1",0) PO^VA(200,:EM "QUES","XPM1","??") ^D MG^XPDH "QUES","XPM1","A") Enter the Coordinator for Mail Group '|FLAG|' "QUES","XPM1","B") "QUES","XPM1","M") D XPM1^XPDIQ "QUES","XPO1",0) Y "QUES","XPO1","??") ^D MENU^XPDH "QUES","XPO1","A") Want KIDS to Rebuild Menu Trees Upon Completion of Install "QUES","XPO1","B") NO "QUES","XPO1","M") D XPO1^XPDIQ "QUES","XPZ1",0) Y "QUES","XPZ1","??") ^D OPT^XPDH "QUES","XPZ1","A") Want to DISABLE Scheduled Options, Menu Options, and Protocols "QUES","XPZ1","B") YES "QUES","XPZ1","M") D XPZ1^XPDIQ "QUES","XPZ2",0) Y "QUES","XPZ2","??") ^D RTN^XPDH "QUES","XPZ2","A") Want to MOVE routines to other CPUs "QUES","XPZ2","B") NO "QUES","XPZ2","M") D XPZ2^XPDIQ "RTN") 2 "RTN","PRCHLO3") 0^1^B153453811^B150252555 "RTN","PRCHLO3",1,0) PRCHLO3 ;WOIFO/RLL-EXTRACT ROUTINE CLO REPORT SERVER ; 10/8/10 9:08am "RTN","PRCHLO3",2,0) ;;5.1;IFCAP;**83,130,151**;Oct 20, 2000;Build 4 "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) ;added by patch 151 to support new fields "RTN","PRCHLO3",266,0) W "AuthIEN^AuthCode^AuthDesc^SubAuthIEN^SubAuthCode^SubAuthDesc^" "RTN","PRCHLO3",267,0) W "ServiceStartDate^ServiceEndDate",! "RTN","PRCHLO3",268,0) Q "RTN","PRCHLO3",269,0) CONTRPW ; Write File 410 data (Control Point Activities) "RTN","PRCHLO3",270,0) N GPOID,GPOND "RTN","PRCHLO3",271,0) S GPOID=0,GPOND="" "RTN","PRCHLO3",272,0) F S GPOID=$O(^TMP($J,"CONTRP",GPOID)) Q:GPOID="" D "RTN","PRCHLO3",273,0) . F S GPOND=$O(^TMP($J,"CONTRP",GPOID,GPOND)) Q:GPOND="" D "RTN","PRCHLO3",274,0) . . W $G(^TMP($J,"CONTRP",GPOID,GPOND)) "RTN","PRCHLO3",275,0) . . Q "RTN","PRCHLO3",276,0) . W ! ; new line for each file #410 entry "RTN","PRCHLO3",277,0) . Q "RTN","PRCHLO3",278,0) Q "RTN","PRCHLO3",279,0) SUBCPH ; Write File 410.04 header (Sub Control Point) "RTN","PRCHLO3",280,0) W "TransactionNumber^TransactionIEN^StationNumber^StationPONoIEN^StationPONoEXT^PoDate^MonthYrRun^SubControlPoint^Amount^SCPAMT",! "RTN","PRCHLO3",281,0) Q "RTN","PRCHLO3",282,0) SUBCPW ; Write File 410.04 data (Sub Control Point) "RTN","PRCHLO3",283,0) N GPOID,GPOND "RTN","PRCHLO3",284,0) S GPOID=0,GPOND="" "RTN","PRCHLO3",285,0) F S GPOID=$O(^TMP($J,"SUBCP",GPOID)) Q:GPOID="" D "RTN","PRCHLO3",286,0) . F S GPOND=$O(^TMP($J,"SUBCP",GPOID,GPOND)) Q:GPOND="" D "RTN","PRCHLO3",287,0) . . W $G(^TMP($J,"SUBCP",GPOID,GPOND)),! "RTN","PRCHLO3",288,0) . . Q "RTN","PRCHLO3",289,0) . Q "RTN","PRCHLO3",290,0) Q "RTN","PRCHLO3",291,0) DR1358H ; Write File 424 header (1358 Daily Record) "RTN","PRCHLO3",292,0) W "PoIdNum^PurchaseOrderNum^PoDate^MonthYrRun^StationNum^AuthorizationNumber^TransactionType^" "RTN","PRCHLO3",293,0) W "LiquidationAmount^AuthBalance^ObligationAmount^DateTime^UserDUZ^" "RTN","PRCHLO3",294,0) W "UserName^UserSVCint^UserSVCext^CompletedFlag^Reference^" "RTN","PRCHLO3",295,0) W "LastSequenceUsed^AuthAmount^" "RTN","PRCHLO3",296,0) W "OriginalAuthAmount^LastEditByDUZ^LastEditByName^LastEditBySVCint^" "RTN","PRCHLO3",297,0) W "LastEditBySVCext^CPApointerIEN^CPApointerEXT^Comments^InterfaceID",! "RTN","PRCHLO3",298,0) Q "RTN","PRCHLO3",299,0) DR1358W ; Write File 424 data (1358 Daily Record) "RTN","PRCHLO3",300,0) N GPOID,GPOND "RTN","PRCHLO3",301,0) S GPOID=0,GPOND="" "RTN","PRCHLO3",302,0) F S GPOID=$O(^TMP($J,"DR1358",GPOID)) Q:GPOID="" D "RTN","PRCHLO3",303,0) . F S GPOND=$O(^TMP($J,"DR1358",GPOID,GPOND)) Q:GPOND="" D "RTN","PRCHLO3",304,0) . . W $G(^TMP($J,"DR1358",GPOID,GPOND)),! "RTN","PRCHLO3",305,0) . . Q "RTN","PRCHLO3",306,0) . Q "RTN","PRCHLO3",307,0) Q "RTN","PRCHLO3",308,0) AD1358H ; Write File 424.1 header (1358 Authorization Detail) "RTN","PRCHLO3",309,0) W "PoIdNum^PurchaseOrderNum^PoDate^MonthYrRun^StationNum^BillNumber^RecordType^AuthPointerIEN^AuthPointerEXT^AuthAmount^" "RTN","PRCHLO3",310,0) W "DateTime^UserDUZ^UserName^UserSVCint^UserSVCext^" "RTN","PRCHLO3",311,0) W "VendorInvoiceNumber^FinalBill^Reference^LastEditedByDUZ^" "RTN","PRCHLO3",312,0) W "LastEditedByName^LastEditedBySVCint^LastEditedBySVCext^Description",! "RTN","PRCHLO3",313,0) Q "RTN","PRCHLO3",314,0) AD1358W ; Write File 424.1 data (1358 Authorization Detail) "RTN","PRCHLO3",315,0) N GPOID,GPOND "RTN","PRCHLO3",316,0) S GPOID=0,GPOND="" "RTN","PRCHLO3",317,0) F S GPOID=$O(^TMP($J,"AD1358",GPOID)) Q:GPOID="" D "RTN","PRCHLO3",318,0) . F S GPOND=$O(^TMP($J,"AD1358",GPOID,GPOND)) Q:GPOND="" D "RTN","PRCHLO3",319,0) . . W $G(^TMP($J,"AD1358",GPOID,GPOND)),! "RTN","PRCHLO3",320,0) . . Q "RTN","PRCHLO3",321,0) . Q "RTN","PRCHLO3",322,0) Q "RTN","PRCHLO6") 0^2^B136943569^B125729852 "RTN","PRCHLO6",1,0) PRCHLO6 ;WOIFO/AS-EXTRACT ROUTINE (cont.)CLO REPORT SERVER ; 10/8/10 1:11pm "RTN","PRCHLO6",2,0) ;;5.1;IFCAP;**130,140,151**;Oct 20, 2000;Build 4 "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,PRCIX,PRCAUIEN,PRCARY "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_U "RTN","PRCHLO6",132,0) ;;authority;sub-authority ;AUTHORITY/SUB-AUTHORITY "RTN","PRCHLO6",133,0) S PRCDT="" "RTN","PRCHLO6",134,0) S PRCND=$G(^PRCS(410,PRCIEN,11)) ;NODE 11 "RTN","PRCHLO6",135,0) F PRCIX=4,5 D "RTN","PRCHLO6",136,0) . S PRCAUIEN=$P(PRCND,U,PRCIX) ;auth ien "RTN","PRCHLO6",137,0) . S PRCDT=$S(PRCIX=4:PRCAUIEN,1:PRCDT_U_PRCAUIEN) "RTN","PRCHLO6",138,0) . D GETS^DIQ(410.9,+PRCAUIEN_",",".01;.02","","PRCARY") "RTN","PRCHLO6",139,0) . S PRCDT=PRCDT_U_$G(PRCARY(410.9,+PRCAUIEN_",",.01))_U_$G(PRCARY(410.9,+PRCAUIEN_",",.02)) "RTN","PRCHLO6",140,0) ;;service dates ;SERVICE DATES "RTN","PRCHLO6",141,0) S PRCND=$G(^PRCS(410,PRCIEN,1)) ;NODE 1 "RTN","PRCHLO6",142,0) F PRCIX=6,7 D "RTN","PRCHLO6",143,0) . S PRCDT=PRCDT_U_$$FMTE^XLFDT($P(PRCND,U,PRCIX)) "RTN","PRCHLO6",144,0) S ^TMP($J,"CONTRP",PRCIEN,5)=PRCDT "RTN","PRCHLO6",145,0) ; "RTN","PRCHLO6",146,0) D GET4104 "RTN","PRCHLO6",147,0) Q "RTN","PRCHLO6",148,0) GET4104 ; GET DATA FROM SUBFILE 410.04 "RTN","PRCHLO6",149,0) N PRCX S PRCX=$P(^PRCS(410,PRCIEN,0),U)_U_PRCIEN_U_$P(^(0),U,5)_U "RTN","PRCHLO6",150,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",151,0) N PRCTMI "RTN","PRCHLO6",152,0) S PRCTMI=0 F S PRCTMI=$O(^PRCS(410,PRCIEN,12,PRCTMI)) Q:'PRCTMI D "RTN","PRCHLO6",153,0) . S PRCDT=PRCX "RTN","PRCHLO6",154,0) . S PRCND=$G(^PRCS(410,PRCIEN,12,PRCTMI,0)) "RTN","PRCHLO6",155,0) . S PRCDT=PRCDT_$P($G(^PRCS(410.4,+$P(PRCND,U,1),0)),U)_U ;SUB-CONTROL POINT "RTN","PRCHLO6",156,0) . S PRCDT=PRCDT_$P(PRCND,U,2)_U ;AMOUNT "RTN","PRCHLO6",157,0) . S PRCTMB=$$GET1^DIQ(410.04,PRCTMI_","_PRCIEN_",",2) "RTN","PRCHLO6",158,0) . S PRCDT=PRCDT_PRCTMB ;SCP AMOUNT "RTN","PRCHLO6",159,0) . S ^TMP($J,"SUBCP",PRCIEN,PRCTMI)=PRCDT "RTN","PRCHLO6",160,0) Q "RTN","PRCHLO6",161,0) WORDFLD ; PROCESS WORD FIELD "RTN","PRCHLO6",162,0) N PRCTMI,PRCTMJ,PRCTMQ "RTN","PRCHLO6",163,0) S PRCTMI=$P($G(^PRCS(410,PRCIEN,PRCTMB,0)),U,3),PRCTMP="",PRCTMQ=0 "RTN","PRCHLO6",164,0) I PRCTMI D "RTN","PRCHLO6",165,0) . F PRCTMI=1:1:PRCTMI D Q:PRCTMQ "RTN","PRCHLO6",166,0) .. S PRCTMJ=$G(^PRCS(410,PRCIEN,PRCTMB,PRCTMI,0))_" " "RTN","PRCHLO6",167,0) .. I $F(PRCTMJ,"^") S PRCTMJ=$TR(PRCTMJ,"^","*") ;CONVERT ^ TO * "RTN","PRCHLO6",168,0) .. I $L(PRCTMJ)+$L(PRCTMP)>200 S PRCTMP=$E(PRCTMP_PRCTMJ,1,200) S PRCTMQ=1 Q ; CANNOT ALLOW STRING 'PRCDT' TO EXCEED 256 BYTES, SO LIMITING WORD PROC FIELD TO 200 CHARS "RTN","PRCHLO6",169,0) .. S PRCTMP=PRCTMP_PRCTMJ "RTN","PRCHLO6",170,0) Q "RTN","PRCHLO6",171,0) ; "RTN","PRCHLO6",172,0) GET424 ; "RTN","PRCHLO6",173,0) S U="^" "RTN","PRCHLO6",174,0) N PRCND,PRCIEN,PRCDT,PRCTMP,PRCTMB,PRCC,X "RTN","PRCHLO6",175,0) ; loop through file 424, "C" Cross Reference "RTN","PRCHLO6",176,0) S PRCC=0 "RTN","PRCHLO6",177,0) F S PRCC=$O(^PRC(424,"C",PRCC)) Q:'PRCC D "RTN","PRCHLO6",178,0) . I $D(^TMP($J,"POMAST",PRCC)) D DAT424 "RTN","PRCHLO6",179,0) D GET4241 "RTN","PRCHLO6",180,0) Q "RTN","PRCHLO6",181,0) DAT424 ; "RTN","PRCHLO6",182,0) N PRCPOID "RTN","PRCHLO6",183,0) S PRCIEN=0 "RTN","PRCHLO6",184,0) F S PRCIEN=$O(^PRC(424,"C",PRCC,PRCIEN)) Q:'PRCIEN D "RTN","PRCHLO6",185,0) . S PRCDT="" "RTN","PRCHLO6",186,0) . S PRCND=$G(^PRC(424,PRCIEN,0)) ;NODE 0 "RTN","PRCHLO6",187,0) . S (PRCPOID,X,Y)=$P(PRCND,U,2),PRCDT=PRCDT_X_U ;OBLIGATION INT "RTN","PRCHLO6",188,0) . S X=$S(X>0:$P($G(^PRC(442,X,0)),U),1:""),PRCDT=PRCDT_X_U ; OBL EXT "RTN","PRCHLO6",189,0) . S PRCDT=PRCDT_$$PODATE(PRCPOID)_U ;PO DATE "RTN","PRCHLO6",190,0) . S PRCDT=PRCDT_MNTHYR_U ;Month,Year of extract "RTN","PRCHLO6",191,0) . S PRCDT=PRCDT_$P(X,"-")_U ;STATION # "RTN","PRCHLO6",192,0) . S PRCDT=PRCDT_$P(PRCND,U,1)_U ;AUTHORIZATION # "RTN","PRCHLO6",193,0) . S PRCDT=PRCDT_$$GET1^DIQ(424,PRCIEN_",",.03)_U ;TRANSACTION TYPE "RTN","PRCHLO6",194,0) . S PRCDT=PRCDT_$P(PRCND,U,4)_U ;LIQUIDATION AMOUNT "RTN","PRCHLO6",195,0) . S PRCDT=PRCDT_$P(PRCND,U,5)_U ;AUTHORIZATION BALANCE "RTN","PRCHLO6",196,0) . S PRCDT=PRCDT_$P(PRCND,U,6)_U ;OBLIGATION AMOUNT "RTN","PRCHLO6",197,0) . S X=$P(PRCND,U,7),PRCDT=PRCDT_$S(X>0:$$FMTE^XLFDT($P(X,".")),1:"")_U ;DATE/TIME "RTN","PRCHLO6",198,0) . S PRCDUZ=$P(PRCND,U,8),PRCTMP=$P($G(^VA(200,+PRCDUZ,0)),U) "RTN","PRCHLO6",199,0) . S PRCDT=PRCDT_PRCDUZ_U ;USER DUZ "RTN","PRCHLO6",200,0) . S PRCDT=PRCDT_PRCTMP_U ;USER NAME "RTN","PRCHLO6",201,0) . S PRCDUZ=$P($G(^VA(200,+PRCDUZ,5)),U) "RTN","PRCHLO6",202,0) . S PRCTMP=$S(PRCDUZ="":"",1:$$GET1^DIQ(49,+PRCDUZ_",",.01)) "RTN","PRCHLO6",203,0) . S PRCDT=PRCDT_PRCDUZ_U_PRCTMP_U ;USER SERVICE INT/EXT "RTN","PRCHLO6",204,0) . S PRCDT=PRCDT_$$GET1^DIQ(424,PRCIEN_",",.09)_U ;COMPLETED FLAG "RTN","PRCHLO6",205,0) . S PRCDT=PRCDT_$P(PRCND,U,10)_U ;REFERENCE "RTN","PRCHLO6",206,0) . S PRCDT=PRCDT_$P(PRCND,U,11)_U ;LAST SEQUENCE USED "RTN","PRCHLO6",207,0) . S PRCDT=PRCDT_$P(PRCND,U,12)_U ;AUTHORIZATION AMOUNT "RTN","PRCHLO6",208,0) . S PRCDT=PRCDT_$P(PRCND,U,13)_U ;ORIGINAL AUTH. AMOUNT "RTN","PRCHLO6",209,0) . S PRCDUZ=$P(PRCND,U,14),PRCTMP=$P($G(^VA(200,+PRCDUZ,0)),U) "RTN","PRCHLO6",210,0) . S PRCDT=PRCDT_PRCDUZ_U ;LAST EDITED BY DUZ "RTN","PRCHLO6",211,0) . S PRCDT=PRCDT_PRCTMP_U ;LAST EDITED BY NAME "RTN","PRCHLO6",212,0) . S PRCDUZ=$P($G(^VA(200,+PRCDUZ,5)),U) "RTN","PRCHLO6",213,0) . S PRCTMP=$S(PRCDUZ="":"",1:$$GET1^DIQ(49,+PRCDUZ_",",.01)) "RTN","PRCHLO6",214,0) . S PRCDT=PRCDT_PRCDUZ_U_PRCTMP_U ;LAST EDITED BY SERVICE INT/EXT "RTN","PRCHLO6",215,0) . S PRCTMP=$P(PRCND,U,15),PRCTMP=$P($G(^PRCS(410,+PRCTMP,0)),U) "RTN","PRCHLO6",216,0) . S PRCDT=PRCDT_$P(PRCND,U,15)_U ;CPA POINTER IEN "RTN","PRCHLO6",217,0) . S PRCDT=PRCDT_PRCTMP_U ;CPA POINTER EXT "RTN","PRCHLO6",218,0) . S PRCND=$G(^PRC(424,PRCIEN,1)) ;NODE 1 "RTN","PRCHLO6",219,0) . S PRCDT=PRCDT_$P(PRCND,U,1)_U ;COMMENTS "RTN","PRCHLO6",220,0) . S PRCND=$G(^PRC(424,PRCIEN,2)) ;NODE 2 "RTN","PRCHLO6",221,0) . S PRCDT=PRCDT_$P(PRCND,U,2) ;INTERFACE ID "RTN","PRCHLO6",222,0) . S ^TMP($J,"DR1358",PRCIEN,1)=PRCDT "RTN","PRCHLO6",223,0) Q "RTN","PRCHLO6",224,0) GET4241 ; "RTN","PRCHLO6",225,0) ; loop through file 424.1 "RTN","PRCHLO6",226,0) S PRCC=0 "RTN","PRCHLO6",227,0) F S PRCC=$O(^PRC(424.1,"C",PRCC)) Q:'PRCC D "RTN","PRCHLO6",228,0) . I $D(^TMP($J,"DR1358",PRCC)) D DAT4241 "RTN","PRCHLO6",229,0) Q "RTN","PRCHLO6",230,0) DAT4241 ; "RTN","PRCHLO6",231,0) N Y,PRCSTN "RTN","PRCHLO6",232,0) S PRCIEN=0 F S PRCIEN=$O(^PRC(424.1,"C",PRCC,PRCIEN)) Q:'PRCIEN D "RTN","PRCHLO6",233,0) . S PRCDT="" "RTN","PRCHLO6",234,0) . S PRCND=$G(^PRC(424.1,PRCIEN,0)) ;NODE 0 "RTN","PRCHLO6",235,0) . S X=$P(PRCND,U,2) "RTN","PRCHLO6",236,0) . S (X,PRCPOID)=$P($G(^PRC(424,+X,0)),U,2),PRCDT=PRCDT_X_U ;PO# INT "RTN","PRCHLO6",237,0) . S X=$S(X>0:$P($G(^PRC(442,X,0)),U),1:""),PRCDT=PRCDT_X_U ;PO# EXT "RTN","PRCHLO6",238,0) . S PRCSTN=$P(X,"-") S:PRCPOID="" PRCPOID=PRCIEN "RTN","PRCHLO6",239,0) . S PRCDT=PRCDT_$$PODATE(PRCPOID)_U ;PO DATE "RTN","PRCHLO6",240,0) . S PRCDT=PRCDT_MNTHYR_U ;Month,Year of extract "RTN","PRCHLO6",241,0) . S PRCDT=PRCDT_PRCSTN_U ;STATION "RTN","PRCHLO6",242,0) . S PRCDT=PRCDT_$P(PRCND,U,1)_U ;BILL NUMBER "RTN","PRCHLO6",243,0) . S PRCDT=PRCDT_$$GET1^DIQ(424.1,PRCIEN_",",.011)_U ;RECORD TYPE "RTN","PRCHLO6",244,0) . S PRCTMP=$P(PRCND,U,2),PRCTMP=$P($G(^PRC(424,+PRCTMP,0)),U) "RTN","PRCHLO6",245,0) . S PRCDT=PRCDT_$P(PRCND,U,2)_U ;AUTH. POINTER IEN "RTN","PRCHLO6",246,0) . S PRCDT=PRCDT_PRCTMP_U ;AUTH. POINTER EXT "RTN","PRCHLO6",247,0) . S PRCDT=PRCDT_$P(PRCND,U,3)_U ;AUTH. AMOUNT "RTN","PRCHLO6",248,0) . S X=$P(PRCND,U,4),PRCDT=PRCDT_$S(X>0:$$FMTE^XLFDT($P(X,".")),1:"")_U ;DATE/TIME "RTN","PRCHLO6",249,0) . S PRCDUZ=$P(PRCND,U,5),PRCTMP=$P($G(^VA(200,+PRCDUZ,0)),U) "RTN","PRCHLO6",250,0) . S PRCDT=PRCDT_PRCDUZ_U ;USER DUZ "RTN","PRCHLO6",251,0) . S PRCDT=PRCDT_PRCTMP_U ;USER NAME "RTN","PRCHLO6",252,0) . S PRCDUZ=$P($G(^VA(200,+PRCDUZ,5)),U) "RTN","PRCHLO6",253,0) . S PRCTMP=$S(PRCDUZ="":"",1:$$GET1^DIQ(49,+PRCDUZ_",",.01)) "RTN","PRCHLO6",254,0) . S PRCDT=PRCDT_PRCDUZ_U_PRCTMP_U ;USER SERVICE INT/EXT "RTN","PRCHLO6",255,0) . S PRCDT=PRCDT_$P(PRCND,U,6)_U ;VENDOR INVOICE NUMBER "RTN","PRCHLO6",256,0) . S PRCDT=PRCDT_$$GET1^DIQ(424.1,PRCIEN_",",.07)_U ;FINAL BILL "RTN","PRCHLO6",257,0) . S PRCDT=PRCDT_$P(PRCND,U,8)_U ;REFERENCE "RTN","PRCHLO6",258,0) . S PRCDUZ=$P(PRCND,U,10),PRCTMP=$P($G(^VA(200,+PRCDUZ,0)),U) "RTN","PRCHLO6",259,0) . S PRCDT=PRCDT_PRCDUZ_U ;LAST EDITED BY DUZ "RTN","PRCHLO6",260,0) . S PRCDT=PRCDT_PRCTMP_U ;LAST EDITED BY NAME "RTN","PRCHLO6",261,0) . S PRCDUZ=$P($G(^VA(200,+PRCDUZ,5)),U) "RTN","PRCHLO6",262,0) . S PRCTMP=$S(PRCDUZ="":"",1:$$GET1^DIQ(49,+PRCDUZ_",",.01)) "RTN","PRCHLO6",263,0) . S PRCDT=PRCDT_PRCDUZ_U_PRCTMP_U ;LAST EDITED BY SERVICE INT/EXT "RTN","PRCHLO6",264,0) . S PRCND=$G(^PRC(424.1,PRCIEN,1)) ;NODE 1 "RTN","PRCHLO6",265,0) . S PRCDT=PRCDT_$P(PRCND,U,1) ;DESCRIPTION "RTN","PRCHLO6",266,0) . S ^TMP($J,"AD1358",PRCIEN,1)=PRCDT "RTN","PRCHLO6",267,0) Q "RTN","PRCHLO6",268,0) PODATE(PRCPOIEN) ;input PO's ien, output external form PO Date "RTN","PRCHLO6",269,0) N X "RTN","PRCHLO6",270,0) S X=$S(PRCPOIEN>0:$P($G(^PRC(442,PRCPOIEN,1)),U,15),1:"") "RTN","PRCHLO6",271,0) S:X'="" X=$$FMTE^XLFDT(X,"D") "RTN","PRCHLO6",272,0) Q X "VER") 8.0^22.0 "BLD",6576,6) ^126 **END** **END**