KIDS Distribution saved on Jul 14, 2006@15:00 FM To Cache SQL Mapping Tool - Version 1.0 Build 8 **KIDS**:FM TO CACHE SQL 1.0^ **INSTALL NAME** FM TO CACHE SQL 1.0 "BLD",3512,0) FM TO CACHE SQL 1.0^FM TO CACHE SQL^0^3060714^y "BLD",3512,1,0) ^^1^1^3060513^ "BLD",3512,1,1,0) FileMan To Cache SQL Mapping Tool - Version 1.0 Build 8 "BLD",3512,4,0) ^9.64PA^15050.14^5 "BLD",3512,4,15050.11,0) 15050.11 "BLD",3512,4,15050.11,222) y^y^f^^^^n "BLD",3512,4,15050.12,0) 15050.12 "BLD",3512,4,15050.12,222) y^y^f^^^^n "BLD",3512,4,15050.13,0) 15050.13 "BLD",3512,4,15050.13,222) y^y^f^^^^n "BLD",3512,4,15050.14,0) 15050.14 "BLD",3512,4,15050.14,222) y^y^f^^n^^y^a^n "BLD",3512,4,15050.19,0) 15050.19 "BLD",3512,4,15050.19,222) y^y^f^^^^n "BLD",3512,4,"B",15050.11,15050.11) "BLD",3512,4,"B",15050.12,15050.12) "BLD",3512,4,"B",15050.13,15050.13) "BLD",3512,4,"B",15050.14,15050.14) "BLD",3512,4,"B",15050.19,15050.19) "BLD",3512,"ABPKG") n "BLD",3512,"INI") CLEAN^CASHI "BLD",3512,"INID") n^n^n "BLD",3512,"INIT") POST^CASHI "BLD",3512,"KRN",0) ^9.67PA^8989.52^19 "BLD",3512,"KRN",.4,0) .4 "BLD",3512,"KRN",.401,0) .401 "BLD",3512,"KRN",.402,0) .402 "BLD",3512,"KRN",.403,0) .403 "BLD",3512,"KRN",.5,0) .5 "BLD",3512,"KRN",.84,0) .84 "BLD",3512,"KRN",3.6,0) 3.6 "BLD",3512,"KRN",3.8,0) 3.8 "BLD",3512,"KRN",9.2,0) 9.2 "BLD",3512,"KRN",9.8,0) 9.8 "BLD",3512,"KRN",9.8,"NM",0) ^9.68A^46^45 "BLD",3512,"KRN",9.8,"NM",1,0) CASH^^0^B23854241 "BLD",3512,"KRN",9.8,"NM",2,0) CASH0^^0^B5250002 "BLD",3512,"KRN",9.8,"NM",3,0) CASH1^^0^B36770570 "BLD",3512,"KRN",9.8,"NM",4,0) CASH2^^0^B69666901 "BLD",3512,"KRN",9.8,"NM",5,0) CASH3^^0^B74243014 "BLD",3512,"KRN",9.8,"NM",6,0) CASHC^^0^B62590378 "BLD",3512,"KRN",9.8,"NM",7,0) CASHC0^^0^B29275632 "BLD",3512,"KRN",9.8,"NM",8,0) CASHC1^^0^B78110022 "BLD",3512,"KRN",9.8,"NM",9,0) CASHC2^^0^B60203658 "BLD",3512,"KRN",9.8,"NM",10,0) CASHC3^^0^B80053616 "BLD",3512,"KRN",9.8,"NM",11,0) CASHC4^^0^B59935224 "BLD",3512,"KRN",9.8,"NM",12,0) CASHC5^^0^B30316225 "BLD",3512,"KRN",9.8,"NM",13,0) CASHCU^^0^B35588272 "BLD",3512,"KRN",9.8,"NM",14,0) CASHD^^0^B63871937 "BLD",3512,"KRN",9.8,"NM",15,0) CASHDT01^^0^B23175140 "BLD",3512,"KRN",9.8,"NM",16,0) CASHDT02^^0^B25155181 "BLD",3512,"KRN",9.8,"NM",17,0) CASHDT03^^0^B50096997 "BLD",3512,"KRN",9.8,"NM",18,0) CASHDT04^^0^B19238130 "BLD",3512,"KRN",9.8,"NM",19,0) CASHDT05^^0^B34572561 "BLD",3512,"KRN",9.8,"NM",20,0) CASHDT06^^0^B65854905 "BLD",3512,"KRN",9.8,"NM",21,0) CASHDT07^^0^B25629428 "BLD",3512,"KRN",9.8,"NM",22,0) CASHDT08^^0^B20627139 "BLD",3512,"KRN",9.8,"NM",23,0) CASHFN11^^0^B38734702 "BLD",3512,"KRN",9.8,"NM",24,0) CASHFN12^^0^B10663721 "BLD",3512,"KRN",9.8,"NM",25,0) CASHFN13^^0^B3395043 "BLD",3512,"KRN",9.8,"NM",26,0) CASHFN19^^0^B16611231 "BLD",3512,"KRN",9.8,"NM",27,0) CASHI^^0^B9673499 "BLD",3512,"KRN",9.8,"NM",28,0) CASHR^^0^B32370795 "BLD",3512,"KRN",9.8,"NM",29,0) CASHU^^0^B4005707 "BLD",3512,"KRN",9.8,"NM",30,0) CASHV4C^^0^B59211480 "BLD",3512,"KRN",9.8,"NM",31,0) CASHV4C0^^0^B10300922 "BLD",3512,"KRN",9.8,"NM",32,0) CASHV4C1^^0^B78948097 "BLD",3512,"KRN",9.8,"NM",33,0) CASHV4C2^^0^B12681943 "BLD",3512,"KRN",9.8,"NM",34,0) CASHV4C3^^0^B9394300 "BLD",3512,"KRN",9.8,"NM",35,0) CASHV4C4^^0^B50425881 "BLD",3512,"KRN",9.8,"NM",36,0) CASHV4D^^0^B75367826 "BLD",3512,"KRN",9.8,"NM",38,0) CASHN^^0^B6286040 "BLD",3512,"KRN",9.8,"NM",39,0) CASHR0^^0^B19713130 "BLD",3512,"KRN",9.8,"NM",40,0) CASHUT^^0^B23058184 "BLD",3512,"KRN",9.8,"NM",41,0) CASHUT01^^0^B16006893 "BLD",3512,"KRN",9.8,"NM",42,0) CASHUT02^^0^B86309925 "BLD",3512,"KRN",9.8,"NM",43,0) CASHV4UT^^0^B18435414 "BLD",3512,"KRN",9.8,"NM",44,0) CASHF^^0^B7955740 "BLD",3512,"KRN",9.8,"NM",45,0) CASHCN^^0^B13052905 "BLD",3512,"KRN",9.8,"NM",46,0) CASHFN14^^0^B5900231 "BLD",3512,"KRN",9.8,"NM","B","CASH",1) "BLD",3512,"KRN",9.8,"NM","B","CASH0",2) "BLD",3512,"KRN",9.8,"NM","B","CASH1",3) "BLD",3512,"KRN",9.8,"NM","B","CASH2",4) "BLD",3512,"KRN",9.8,"NM","B","CASH3",5) "BLD",3512,"KRN",9.8,"NM","B","CASHC",6) "BLD",3512,"KRN",9.8,"NM","B","CASHC0",7) "BLD",3512,"KRN",9.8,"NM","B","CASHC1",8) "BLD",3512,"KRN",9.8,"NM","B","CASHC2",9) "BLD",3512,"KRN",9.8,"NM","B","CASHC3",10) "BLD",3512,"KRN",9.8,"NM","B","CASHC4",11) "BLD",3512,"KRN",9.8,"NM","B","CASHC5",12) "BLD",3512,"KRN",9.8,"NM","B","CASHCN",45) "BLD",3512,"KRN",9.8,"NM","B","CASHCU",13) "BLD",3512,"KRN",9.8,"NM","B","CASHD",14) "BLD",3512,"KRN",9.8,"NM","B","CASHDT01",15) "BLD",3512,"KRN",9.8,"NM","B","CASHDT02",16) "BLD",3512,"KRN",9.8,"NM","B","CASHDT03",17) "BLD",3512,"KRN",9.8,"NM","B","CASHDT04",18) "BLD",3512,"KRN",9.8,"NM","B","CASHDT05",19) "BLD",3512,"KRN",9.8,"NM","B","CASHDT06",20) "BLD",3512,"KRN",9.8,"NM","B","CASHDT07",21) "BLD",3512,"KRN",9.8,"NM","B","CASHDT08",22) "BLD",3512,"KRN",9.8,"NM","B","CASHF",44) "BLD",3512,"KRN",9.8,"NM","B","CASHFN11",23) "BLD",3512,"KRN",9.8,"NM","B","CASHFN12",24) "BLD",3512,"KRN",9.8,"NM","B","CASHFN13",25) "BLD",3512,"KRN",9.8,"NM","B","CASHFN14",46) "BLD",3512,"KRN",9.8,"NM","B","CASHFN19",26) "BLD",3512,"KRN",9.8,"NM","B","CASHI",27) "BLD",3512,"KRN",9.8,"NM","B","CASHN",38) "BLD",3512,"KRN",9.8,"NM","B","CASHR",28) "BLD",3512,"KRN",9.8,"NM","B","CASHR0",39) "BLD",3512,"KRN",9.8,"NM","B","CASHU",29) "BLD",3512,"KRN",9.8,"NM","B","CASHUT",40) "BLD",3512,"KRN",9.8,"NM","B","CASHUT01",41) "BLD",3512,"KRN",9.8,"NM","B","CASHUT02",42) "BLD",3512,"KRN",9.8,"NM","B","CASHV4C",30) "BLD",3512,"KRN",9.8,"NM","B","CASHV4C0",31) "BLD",3512,"KRN",9.8,"NM","B","CASHV4C1",32) "BLD",3512,"KRN",9.8,"NM","B","CASHV4C2",33) "BLD",3512,"KRN",9.8,"NM","B","CASHV4C3",34) "BLD",3512,"KRN",9.8,"NM","B","CASHV4C4",35) "BLD",3512,"KRN",9.8,"NM","B","CASHV4D",36) "BLD",3512,"KRN",9.8,"NM","B","CASHV4UT",43) "BLD",3512,"KRN",19,0) 19 "BLD",3512,"KRN",19.1,0) 19.1 "BLD",3512,"KRN",101,0) 101 "BLD",3512,"KRN",409.61,0) 409.61 "BLD",3512,"KRN",771,0) 771 "BLD",3512,"KRN",870,0) 870 "BLD",3512,"KRN",8989.51,0) 8989.51 "BLD",3512,"KRN",8989.52,0) 8989.52 "BLD",3512,"KRN",8994,0) 8994 "BLD",3512,"KRN","B",.4,.4) "BLD",3512,"KRN","B",.401,.401) "BLD",3512,"KRN","B",.402,.402) "BLD",3512,"KRN","B",.403,.403) "BLD",3512,"KRN","B",.5,.5) "BLD",3512,"KRN","B",.84,.84) "BLD",3512,"KRN","B",3.6,3.6) "BLD",3512,"KRN","B",3.8,3.8) "BLD",3512,"KRN","B",9.2,9.2) "BLD",3512,"KRN","B",9.8,9.8) "BLD",3512,"KRN","B",19,19) "BLD",3512,"KRN","B",19.1,19.1) "BLD",3512,"KRN","B",101,101) "BLD",3512,"KRN","B",409.61,409.61) "BLD",3512,"KRN","B",771,771) "BLD",3512,"KRN","B",870,870) "BLD",3512,"KRN","B",8989.51,8989.51) "BLD",3512,"KRN","B",8989.52,8989.52) "BLD",3512,"KRN","B",8994,8994) "BLD",3512,"QUES",0) ^9.62^^ "BLD",3512,"REQB",0) ^9.611^^ "DATA",15050.14,1,0) MAXIMUM FIELDS PER CLASS^250 "DATA",15050.14,2,0) MAXIMUM MULTIPLES PER CLASS^75 "FIA",15050.11) CASH FM CLASS MAP "FIA",15050.11,0) ^CASH(15050.11, "FIA",15050.11,0,0) 15050.11A "FIA",15050.11,0,1) y^y^f^^^^n "FIA",15050.11,0,10) "FIA",15050.11,0,11) "FIA",15050.11,0,"RLRO") "FIA",15050.11,0,"VR") 1.0^FM TO CACHE SQL "FIA",15050.11,15050.11) 0 "FIA",15050.11,15050.111) 0 "FIA",15050.11,15050.1111) 0 "FIA",15050.11,15050.112) 0 "FIA",15050.11,15050.1121) 0 "FIA",15050.11,15050.113) 0 "FIA",15050.11,15050.1131) 0 "FIA",15050.11,15050.1132) 0 "FIA",15050.11,15050.114) 0 "FIA",15050.12) CASH CUSTOM DATATYPES "FIA",15050.12,0) ^CASH(15050.12, "FIA",15050.12,0,0) 15050.12A "FIA",15050.12,0,1) y^y^f^^^^n "FIA",15050.12,0,10) "FIA",15050.12,0,11) "FIA",15050.12,0,"RLRO") "FIA",15050.12,0,"VR") 1.0^FM TO CACHE SQL "FIA",15050.12,15050.12) 0 "FIA",15050.12,15050.121) 0 "FIA",15050.12,15050.122) 0 "FIA",15050.12,15050.1221) 0 "FIA",15050.12,15050.1222) 0 "FIA",15050.12,15050.123) 0 "FIA",15050.12,15050.1231) 0 "FIA",15050.13) CASH ERRORS "FIA",15050.13,0) ^CASH(15050.13, "FIA",15050.13,0,0) 15050.13DA "FIA",15050.13,0,1) y^y^f^^^^n "FIA",15050.13,0,10) "FIA",15050.13,0,11) "FIA",15050.13,0,"RLRO") "FIA",15050.13,0,"VR") 1.0^FM TO CACHE SQL "FIA",15050.13,15050.13) 0 "FIA",15050.13,15050.131) 0 "FIA",15050.14) CASH PARAMETER FILE "FIA",15050.14,0) ^CASH(15050.14, "FIA",15050.14,0,0) 15050.14A "FIA",15050.14,0,1) y^y^f^^n^^y^a^n "FIA",15050.14,0,10) "FIA",15050.14,0,11) "FIA",15050.14,0,"RLRO") "FIA",15050.14,0,"VR") 1.0^FM TO CACHE SQL "FIA",15050.14,15050.14) 0 "FIA",15050.14,15050.141) 0 "FIA",15050.19) CASH SQL RESERVED WORDS "FIA",15050.19,0) ^CASH(15050.19, "FIA",15050.19,0,0) 15050.19 "FIA",15050.19,0,1) y^y^f^^^^n "FIA",15050.19,0,10) "FIA",15050.19,0,11) "FIA",15050.19,0,"RLRO") "FIA",15050.19,0,"VR") 1.0^FM TO CACHE SQL "FIA",15050.19,15050.19) 0 "INI") CLEAN^CASHI "INIT") POST^CASHI "MBREQ") 0 "PKG",190,-1) 1^1 "PKG",190,0) FM TO CACHE SQL^CASH^FileMan To Cache SQL "PKG",190,1,0) ^^1^1^3050718^ "PKG",190,1,1,0) FileMan To Cache SQL Mapping Tool "PKG",190,5) ALBANY "PKG",190,7) ^^I "PKG",190,20,0) ^9.402P^^ "PKG",190,22,0) ^9.49I^1^1 "PKG",190,22,1,0) 1.0^3060714^3051205^1 "PKG",190,22,1,1,0) ^^1^1^3060714 "PKG",190,22,1,1,1,0) FileMan To Cache SQL Mapping Tool - Version 1.0 Build 8 "PKG",190,"DEV") MGC/ALB "PKG",190,"VERSION") 1.0 "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") YES "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") YES "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") 45 "RTN","CASH") 0^1^B23854241 "RTN","CASH",1,0) CASH ;;ALB/MGC - FileMan Class Map Utility ; 11/15/04@3:00:00 "RTN","CASH",2,0) ;;1.0;FM TO CACHE SQL;;Jul 08, 2005 "RTN","CASH",3,0) ; "RTN","CASH",4,0) Q ; Specific Entry Point must be used "RTN","CASH",5,0) ; "RTN","CASH",6,0) ; PUBLIC CALLS "RTN","CASH",7,0) ; "RTN","CASH",8,0) START(FILE,FLAGS,PACKAGE,ID,OWNER,LIST) ; Class Map Utility - Entry Point "RTN","CASH",9,0) ; This call will "Discover" the structure of a FileMan File, and "RTN","CASH",10,0) ; optionally Create and Compile the corresponding Cache Class. "RTN","CASH",11,0) ; Related Classes and Sub-Classes can also be "Discovered", Created "RTN","CASH",12,0) ; and Compiled by using the appropriate input FLAGS. "RTN","CASH",13,0) ; "RTN","CASH",14,0) ; Parameters: "RTN","CASH",15,0) ; "RTN","CASH",16,0) ; FILE - (Required) The FileMan File # to be Discovered "RTN","CASH",17,0) ; FLAGS - (Optional) Optional Flags, listed below "RTN","CASH",18,0) ; PACKAGE - (Optional) Optional Cache Package for generated Classes "RTN","CASH",19,0) ; ID - (Optional) Optional ID string if Simple IDs requested "RTN","CASH",20,0) ; OWNER - (Optional) Optional SQL Username to own generated Classes "RTN","CASH",21,0) ; LIST - (Optional) Optional Array of fields to include, see below "RTN","CASH",22,0) ; "RTN","CASH",23,0) ; Return Value: "RTN","CASH",24,0) ; "RTN","CASH",25,0) ; 1 - Success "RTN","CASH",26,0) ; 0 - Failure "RTN","CASH",27,0) ; "RTN","CASH",28,0) ; FLAGS: "RTN","CASH",29,0) ; "RTN","CASH",30,0) ; C - Compile Create & Compile the Cache classes. "RTN","CASH",31,0) ; [NOTE: The call CREATE^CASH will be executed with "RTN","CASH",32,0) ; all other parameters passed straight through if "RTN","CASH",33,0) ; FLAGS contains "C"] "RTN","CASH",34,0) ; D - Descriptions Add full field descriptions from ^DD. These do "RTN","CASH",35,0) ; not need to be stored in file #15050.11, so this "RTN","CASH",36,0) ; is a compiler only option. Adding the full "RTN","CASH",37,0) ; descriptions mean they will be viewable in the "RTN","CASH",38,0) ; HTML documentation. "RTN","CASH",39,0) ; E - Expand Pointers will generate a Computed Property "RTN","CASH",40,0) ; expanding the .01 field in the pointed to file. "RTN","CASH",41,0) ; [NOTES: "RTN","CASH",42,0) ; 1. Can be used in conjunction with Flag "P". "RTN","CASH",43,0) ; 2. If you want to expand a field other than the "RTN","CASH",44,0) ; .01 default, generate the class and amend the "RTN","CASH",45,0) ; FIELD parameter of the Computed Property] "RTN","CASH",46,0) ; F - Force Force creation and compilation if class already "RTN","CASH",47,0) ; exists. The old version of the class will be "RTN","CASH",48,0) ; deleted!!! "RTN","CASH",49,0) ; H - HDR HDR Compatibility Options. "RTN","CASH",50,0) ; I - Simple IDs Use Simple IDs. "IEN" is the default, unless an "RTN","CASH",51,0) ; alternative ID is passed in ID (e.g "RowID"). "RTN","CASH",52,0) ; L - Loose Loose Validation relaxes the constraints placed "RTN","CASH",53,0) ; on Properties, so exporting data to 3rd party SQL "RTN","CASH",54,0) ; databases becomes easier. You are less likely to "RTN","CASH",55,0) ; get import errors when the FileMan data does not "RTN","CASH",56,0) ; meet constraints (e.g. nulls in required fields). "RTN","CASH",57,0) ; M - Multiples Create sub-classes for Multiples and the "RTN","CASH",58,0) ; appropriate Parent-Child Relationships. "RTN","CASH",59,0) ; N - Simple Names Use simple names (i.e file name concatenated with "RTN","CASH",60,0) ; file #). "RTN","CASH",61,0) ; O - Extended ODBC Changes EXTENDEDODBC=0 param to 1 for SetOfCodes "RTN","CASH",62,0) ; fields. The ODBC output becomes "Int:Ext" format, "RTN","CASH",63,0) ; e.g. "Y:Yes", not just "Yes". "RTN","CASH",64,0) ; P - Pointers Create classes for pointed to files and the "RTN","CASH",65,0) ; appropriate foreign key. "RTN","CASH",66,0) ; [NOTE: Can be used with Flag "E"] "RTN","CASH",67,0) ; Q - SQL only Only tables are compiled, no classes. "RTN","CASH",68,0) ; R - Recursive Recursively expand Multiples and Pointers "RTN","CASH",69,0) ; [NOTE: If this isn't passed, "M" & "P" will be "RTN","CASH",70,0) ; stripped from FLAGS when creating sub-classes "RTN","CASH",71,0) ; and pointed to classes] "RTN","CASH",72,0) ; r - Partially Multiples will generate Classes for any Pointer "RTN","CASH",73,0) ; Recursive Fields, but those Pointers will not create "RTN","CASH",74,0) ; Sub-Classes or Classes for Multiples or Pointers "RTN","CASH",75,0) ; that they contain. "RTN","CASH",76,0) ; S - SOAP WS Create a new Class inherited from "RTN","CASH",77,0) ; %SOAP.WebService. This contains SQL Stored "RTN","CASH",78,0) ; Procedures generated for each index in the main "RTN","CASH",79,0) ; Class (plus the default ByID Procedure). "RTN","CASH",80,0) ; These Queries are also exposed as Web Methods. "RTN","CASH",81,0) ; U - Updateable Changes the READONLY=1 flag to 0, so data can be "RTN","CASH",82,0) ; inserted/updated/deleted via the Class (and SQL). "RTN","CASH",83,0) ; [WARNING: Use with extreme caution!] "RTN","CASH",84,0) ; V - Verbose The default is Silent Mode (though the Cache "RTN","CASH",85,0) ; compile messages will print to screen either "RTN","CASH",86,0) ; way). "RTN","CASH",87,0) ; W - Web Page Add the %CSP.Page SuperClass to the generated "RTN","CASH",88,0) ; Classes ("X" must also be specified). "RTN","CASH",89,0) ; An OnPage() method will be added to the Class "RTN","CASH",90,0) ; to display the output of the XMLDump() method. "RTN","CASH",91,0) ; X - XML Add the %XML.Adaptor SuperClass to the generated "RTN","CASH",92,0) ; Classes. An XMLDump() method will be added to "RTN","CASH",93,0) ; each Class to export the entire file in XML "RTN","CASH",94,0) ; format. This will use the inherited XMLExport() "RTN","CASH",95,0) ; instance method. "RTN","CASH",96,0) ; "RTN","CASH",97,0) ; LIST: "RTN","CASH",98,0) ; "RTN","CASH",99,0) ; [NOTE: If LIST is not passed, all fields will be mapped!!!] "RTN","CASH",100,0) ; "RTN","CASH",101,0) ; The LIST should be in the format: "RTN","CASH",102,0) ; "RTN","CASH",103,0) ; LIST(file#,field#1)="" "RTN","CASH",104,0) ; .. "RTN","CASH",105,0) ; LIST(file#,field#n)="" "RTN","CASH",106,0) ; "RTN","CASH",107,0) ; Only the specified fields will be added to the Class (plus "RTN","CASH",108,0) ; any required keys). "RTN","CASH",109,0) ; "RTN","CASH",110,0) ; To specify fields in Multiples or Pointers, use the relevant "RTN","CASH",111,0) ; Flags ("M" or "P") and add array nodes as follows: "RTN","CASH",112,0) ; "RTN","CASH",113,0) ; LIST(multiple_file#,field#1)="" "RTN","CASH",114,0) ; ... "RTN","CASH",115,0) ; LIST(multiple_file#,field#n)="" "RTN","CASH",116,0) ; "RTN","CASH",117,0) ; LIST(pointer_file#,field#1)="" "RTN","CASH",118,0) ; ... "RTN","CASH",119,0) ; LIST(pointer_file#,field#n)="" "RTN","CASH",120,0) ; "RTN","CASH",121,0) ; Example: "RTN","CASH",122,0) ; "RTN","CASH",123,0) ; LIST(4,.01)="" - .01 field (Name) for file# 4 (Institution) "RTN","CASH",124,0) ; LIST(4,.02)="" - .02 field (State) pointer to file #5 "RTN","CASH",125,0) ; LIST(5,.01)="" - .01 field (Name) for file# 5 (State) "RTN","CASH",126,0) ; LIST(5,3)="" - 3 field (County) multiple file# 5.01 "RTN","CASH",127,0) ; LIST(5.01,.01)="" - .01 field (County) for file #5.01 "RTN","CASH",128,0) ; "RTN","CASH",129,0) ; This produces 3 classes (assuming Flags "M" and "P" are passed) "RTN","CASH",130,0) ; each with one data Property, plus the relevant Relationships and "RTN","CASH",131,0) ; Foreign keys. If Flag "E" is passed aswell a computed field will "RTN","CASH",132,0) ; also be generated for the Pointer. "RTN","CASH",133,0) ; "RTN","CASH",134,0) ; Lock ^XTMP("CASH") "RTN","CASH",135,0) I '$$LOCK^CASHU($J,"START^CASH") Q 0 "RTN","CASH",136,0) ; "RTN","CASH",137,0) ; Initialize optional Parameters "RTN","CASH",138,0) S FLAGS=$G(FLAGS) "RTN","CASH",139,0) S PACKAGE=$G(PACKAGE) "RTN","CASH",140,0) S ID=$G(ID) "RTN","CASH",141,0) S OWNER=$G(OWNER) "RTN","CASH",142,0) I PACKAGE'="",$$SQLRW^CASHU(PACKAGE) W !,"Invalid Package Name (SQL Reserved Word)" Q 0 "RTN","CASH",143,0) I ID'="",$$SQLRW^CASHU(ID) W !,"Invalid ID Name (SQL Reserved Word)" Q 0 "RTN","CASH",144,0) ; "RTN","CASH",145,0) ; Initialize Temporary Globals "RTN","CASH",146,0) K ^TMP("CASH",$J),^TMP("CASHC",$J),^TMP("CASHCW",$J) "RTN","CASH",147,0) ; "RTN","CASH",148,0) N OK "RTN","CASH",149,0) S OK=+$$DISCVR^CASH0(FILE,FLAGS) "RTN","CASH",150,0) ; "RTN","CASH",151,0) ; Create and Compile top level classes if FLAGS["C" "RTN","CASH",152,0) ; (Sub-files must be compiled with their master class) "RTN","CASH",153,0) I OK,FLAGS["C",$$ISFILE^CASHU(FILE) S OK=$$CREATE^CASH0(FILE,FLAGS,PACKAGE,ID,OWNER,.LIST) "RTN","CASH",154,0) ; "RTN","CASH",155,0) ; Delete Temporary Globals and unlock ^XTMP("CASH") "RTN","CASH",156,0) K ^TMP("CASH",$J),^TMP("CASHC",$J),^TMP("CASHCW",$J) "RTN","CASH",157,0) D UNLOCK^CASHU($J) "RTN","CASH",158,0) ; "RTN","CASH",159,0) ; Quit with OK "RTN","CASH",160,0) Q OK "RTN","CASH",161,0) ; "RTN","CASH",162,0) CREATE(FILE,FLAGS,PACKAGE,ID,OWNER,LIST) ; Create and Compile Utility "RTN","CASH",163,0) ; This call Creates and Compiles the Cache Classes for a given file. "RTN","CASH",164,0) ; Related classes will automatically be compiled by the Cache "RTN","CASH",165,0) ; compiler. "RTN","CASH",166,0) ; "RTN","CASH",167,0) ; Parameters: See documentation for START^CASH above! "RTN","CASH",168,0) ; "RTN","CASH",169,0) ; [NOTE: An entry in file #15050.11 - CASH FM CLASS MAP is required, "RTN","CASH",170,0) ; so all files must have been "Discovered" by calling "RTN","CASH",171,0) ; D START^CASH(FILE,FLAGS) beforehand. "RTN","CASH",172,0) ; If FLAGS contains "C" this CREATE function will be called "RTN","CASH",173,0) ; automatically! "RTN","CASH",174,0) ; "RTN","CASH",175,0) ; Lock ^XTMP("CASH") "RTN","CASH",176,0) I '$$LOCK^CASHU($J,"CREATE^CASH") Q 0 "RTN","CASH",177,0) ; "RTN","CASH",178,0) ; Initilize optional Parameters "RTN","CASH",179,0) S FLAGS=$G(FLAGS) "RTN","CASH",180,0) S PACKAGE=$G(PACKAGE) "RTN","CASH",181,0) S ID=$G(ID) "RTN","CASH",182,0) S OWNER=$G(OWNER) "RTN","CASH",183,0) I PACKAGE'="",$$SQLRW^CASHU(PACKAGE) W !,"Invalid Package Name (SQL Reserved Word)" Q 0 "RTN","CASH",184,0) I ID'="",$$SQLRW^CASHU(ID) W !,"Invalid ID Name (SQL Reserved Word)" Q 0 "RTN","CASH",185,0) ; "RTN","CASH",186,0) ; Initialize Temporary Globals "RTN","CASH",187,0) K ^TMP("CASHC",$J),^TMP("CASHCW",$J) "RTN","CASH",188,0) ; "RTN","CASH",189,0) N OK "RTN","CASH",190,0) S OK=$$CREATE^CASH0(FILE,FLAGS,PACKAGE,ID,OWNER,.LIST) "RTN","CASH",191,0) ; "RTN","CASH",192,0) ; Delete Temporary Globals and unlock ^XTMP("CASH") "RTN","CASH",193,0) K ^TMP("CASHC",$J),^TMP("CASHCW",$J) "RTN","CASH",194,0) D UNLOCK^CASHU($J) "RTN","CASH",195,0) ; "RTN","CASH",196,0) ; Quit with OK "RTN","CASH",197,0) Q OK "RTN","CASH",198,0) ; "RTN","CASH",199,0) ALL(FLAGS,PACKAGE,ID,OWNER) ; Compile all FileMan Files "RTN","CASH",200,0) ; This call "Discovers" all FileMan files in a Namespace, then Creates and Compiles them. "RTN","CASH",201,0) ; "RTN","CASH",202,0) N VER "RTN","CASH",203,0) S VER=$$OBJVER^CASHU() "RTN","CASH",204,0) ; "RTN","CASH",205,0) S FLAGS=$G(FLAGS) "RTN","CASH",206,0) S PACKAGE=$G(PACKAGE) "RTN","CASH",207,0) S ID=$G(ID) "RTN","CASH",208,0) S OWNER=$G(OWNER) "RTN","CASH",209,0) I PACKAGE'="",$$SQLRW^CASHU(PACKAGE) W !,"Invalid Package Name (SQL Reserved Word)" Q "RTN","CASH",210,0) I ID'="",$$SQLRW^CASHU(ID) W !,"Invalid ID Name (SQL Reserved Word)" Q "RTN","CASH",211,0) I PACKAGE="" S PACKAGE="User" "RTN","CASH",212,0) ; "RTN","CASH",213,0) ; Call appropriate Compiler "RTN","CASH",214,0) ; Cache Version 5 and greater "RTN","CASH",215,0) I VER>4.1 D ALL^CASHC(FLAGS,PACKAGE,ID,OWNER) Q "RTN","CASH",216,0) ; Cache Version 4.1 "RTN","CASH",217,0) I VER=4.1 D ALL^CASHV4C(FLAGS,PACKAGE,ID,OWNER) Q "RTN","CASH",218,0) ; "RTN","CASH",219,0) ; Non-Cache, or less than Version 4.1 "RTN","CASH",220,0) ; Discover all files "RTN","CASH",221,0) N CNT,FILE,TIME "RTN","CASH",222,0) S TIME(1)=$H "RTN","CASH",223,0) D DELALL^CASHFN11 "RTN","CASH",224,0) S FILE=0 "RTN","CASH",225,0) F S FILE=$O(^DIC(FILE)) Q:'+FILE I $$ISFILE^CASHU(FILE) D DISCVR^CASH0(FILE,"MPRV") "RTN","CASH",226,0) S TIME(2)=$H "RTN","CASH",227,0) S CNT=+$P($G(^CASH(15050.11,0)),"^",4) "RTN","CASH",228,0) W !!,"Total Files Discovered: ",CNT," in ",$$TPLEN^CASHCU(TIME(1),TIME(2)) "RTN","CASH",229,0) Q "RTN","CASH0") 0^2^B5250002 "RTN","CASH0",1,0) CASH0 ;;ALB/MGC - FileMan Class Map Utility - Internal Calls ; 11/15/04@3:00:00 "RTN","CASH0",2,0) ;;1.0;FM TO CACHE SQL;;Jul 08, 2005 "RTN","CASH0",3,0) ; "RTN","CASH0",4,0) CREATE(FILE,FLAGS,PACKAGE,ID,OWNER,LIST) ; Create and Compile Utility "RTN","CASH0",5,0) ; "RTN","CASH0",6,0) ; IMPORTANT: THIS IS AN INTERNAL CALL ONLY! "RTN","CASH0",7,0) ; "RTN","CASH0",8,0) ; NOTE: Called recursively. "RTN","CASH0",9,0) ; "RTN","CASH0",10,0) ; Quit if FILE not passed in "RTN","CASH0",11,0) I $G(FILE)="" W:$G(FLAGS)["V" !,"File# must be passed in",! Q 0 "RTN","CASH0",12,0) ; "RTN","CASH0",13,0) ; Check "Discover" File Exists "RTN","CASH0",14,0) I '$D(^CASH(15050.11,FILE)) W:$G(FLAGS)["V" !,"File#: ",FILE," has not been discovered (use START^CASH)",! Q 0 "RTN","CASH0",15,0) ; "RTN","CASH0",16,0) ; Call appropriate Compiler "RTN","CASH0",17,0) N VER "RTN","CASH0",18,0) S VER=$$OBJVER^CASHU() "RTN","CASH0",19,0) ; Version 5 and greater "RTN","CASH0",20,0) I VER>4.1 Q +$$CREATE^CASHC(FILE,FLAGS,PACKAGE,ID,OWNER,.LIST) "RTN","CASH0",21,0) ; Version 4.1 "RTN","CASH0",22,0) I VER=4.1 Q +$$CREATE^CASHV4C(FILE,FLAGS,PACKAGE,ID,OWNER,.LIST) "RTN","CASH0",23,0) ; Unable to compile "RTN","CASH0",24,0) W !,"You must be running Cache 4.1+ to create and compile Classes" "RTN","CASH0",25,0) Q 0 "RTN","CASH0",26,0) ; "RTN","CASH0",27,0) DISCVR(FILE,FLAGS) ; Discover and Generate Utility "RTN","CASH0",28,0) ; This call Discovers the Classes, Sub-Classes, Referenced Classes, "RTN","CASH0",29,0) ; Properties, Methods and Maps for a given file. "RTN","CASH0",30,0) ; If requested the Cache Classes will be generated. "RTN","CASH0",31,0) ; "RTN","CASH0",32,0) ; Parameters: See documentation for START^CASH above! "RTN","CASH0",33,0) ; "RTN","CASH0",34,0) ; IMPORTANT: THIS IS AN INTERNAL CALL ONLY! "RTN","CASH0",35,0) ; "RTN","CASH0",36,0) ; NOTE: Called recursively. "RTN","CASH0",37,0) ; "RTN","CASH0",38,0) ; Quit if FILE not passed in "RTN","CASH0",39,0) I $G(FILE)="" Q 0 "RTN","CASH0",40,0) ; "RTN","CASH0",41,0) ; Quit if ^DD entry not present (zero node must be non-null) "RTN","CASH0",42,0) I $G(^DD(FILE,0))="" Q 0 "RTN","CASH0",43,0) ; "RTN","CASH0",44,0) ; Quit if this file has already been "Discovered" for this session "RTN","CASH0",45,0) I $D(^TMP("CASH",$J,FILE)) Q 1_"^"_FILE "RTN","CASH0",46,0) S ^TMP("CASH",$J,FILE)="" "RTN","CASH0",47,0) ; "RTN","CASH0",48,0) ; Always re-Discover Files to get any updates (delete previous copy) "RTN","CASH0",49,0) I $D(^CASH(15050.11,FILE)) D DELFILE^CASHFN11(FILE) "RTN","CASH0",50,0) ; "RTN","CASH0",51,0) N FIELD,GLOBAL,ISFILE,MAP,NAME,NIX,NIXF,SQLNM,SUBNM,SUBS,UID "RTN","CASH0",52,0) ; "RTN","CASH0",53,0) ; Determine if the FILE is a top level file, or a sub-file. "RTN","CASH0",54,0) ; Note: If ^DIC exists, but there is also an UP pointer, the file must be treated as "RTN","CASH0",55,0) ; a sub-file as the parent will rely on the relationship being present. "RTN","CASH0",56,0) S ISFILE=$$ISFILE^CASHU(FILE) "RTN","CASH0",57,0) ; "RTN","CASH0",58,0) ; Get File details "RTN","CASH0",59,0) I ISFILE D FILE^CASH1(FILE,.NAME,.SUBNM,.GLOBAL,.SUBS) "RTN","CASH0",60,0) I 'ISFILE D SUBFILE^CASH1(FILE,.NAME,.SUBNM,.GLOBAL,.SUBS) "RTN","CASH0",61,0) ; "RTN","CASH0",62,0) I FLAGS["V" W FILE,": ",NAME,! "RTN","CASH0",63,0) ; "RTN","CASH0",64,0) ; Create Master Map "RTN","CASH0",65,0) S MAP=1 "RTN","CASH0",66,0) S UID="#"_FILE "RTN","CASH0",67,0) D MMAP^CASH1(FILE,UID,GLOBAL,.SUBS) "RTN","CASH0",68,0) ; "RTN","CASH0",69,0) ; Loop through and prepare any New type Regular indexes for this File "RTN","CASH0",70,0) ; Note: The maps need to be added after Field processing to capture Field Labels "RTN","CASH0",71,0) D NEWINX^CASH1(FILE,.NIX,.NIXF) "RTN","CASH0",72,0) ; "RTN","CASH0",73,0) ; Loop through Fields "RTN","CASH0",74,0) D FIELDS^CASH2(FILE,FLAGS,NAME,SUBNM,UID,GLOBAL,.MAP,.SUBS,.NIXF) "RTN","CASH0",75,0) ; "RTN","CASH0",76,0) ; Now add any New type indexes "RTN","CASH0",77,0) D NEWINXU^CASH1(FILE,UID,GLOBAL,MAP,.SUBS,.NIX,.NIXF) "RTN","CASH0",78,0) ; "RTN","CASH0",79,0) Q 1_"^"_FILE "RTN","CASH1") 0^3^B36770570 "RTN","CASH1",1,0) CASH1 ;;ALB/MGC - FileMan Class Map Utility - Internal Calls (File/Map Discovery) ; 11/15/04@3:00:00 "RTN","CASH1",2,0) ;;1.0;FM TO CACHE SQL;;Jul 08, 2005 "RTN","CASH1",3,0) ; "RTN","CASH1",4,0) FILE(FILE,NAME,SUBNM,GLOBAL,SUBS) ; Discover File Details "RTN","CASH1",5,0) N DICNM,GL,I,SQLNM "RTN","CASH1",6,0) ; Unpack Data from ^DIC "RTN","CASH1",7,0) D FILE^CASHF(FILE,.DICNM,.GL) "RTN","CASH1",8,0) ; "RTN","CASH1",9,0) ; Get Global node and subscripts "RTN","CASH1",10,0) S GLOBAL=$P($P(GL,"(",1),"^",2) "RTN","CASH1",11,0) K SUBS "RTN","CASH1",12,0) S SUBS=$P(GL,"(",2) "RTN","CASH1",13,0) F I=1:1:($L(SUBS,",")-1) S SUBS(I)=$P(SUBS,",",I) "RTN","CASH1",14,0) ; "RTN","CASH1",15,0) ; Get Name "RTN","CASH1",16,0) S NAME=$$NAME^CASHN(DICNM) "RTN","CASH1",17,0) ; Make sure SUBNM is null "RTN","CASH1",18,0) S SUBNM="" "RTN","CASH1",19,0) ; Check for SQL Reserved words "RTN","CASH1",20,0) S SQLNM="" "RTN","CASH1",21,0) I $$SQLRW^CASHU(NAME) S SQLNM="_"_NAME "RTN","CASH1",22,0) ; Create new record for File "RTN","CASH1",23,0) D ADDFILE^CASHFN11(FILE,NAME,"",SQLNM,"F","") "RTN","CASH1",24,0) Q "RTN","CASH1",25,0) ; "RTN","CASH1",26,0) SUBFILE(FILE,NAME,SUBNM,GLOBAL,SUBS) ; Discover Sub-File Details "RTN","CASH1",27,0) N DICNM,FLD,FLNO,FTYPE,GL,I,J,K,NM,PFLD,SQLNM "RTN","CASH1",28,0) ; Get hierarchy of files "RTN","CASH1",29,0) ; FLNO(1),NM(1) = This file "RTN","CASH1",30,0) ; FLNO(2),NM(2) = Parent file "RTN","CASH1",31,0) ; FLNO(3),NM(3) = Grandparent file "RTN","CASH1",32,0) ; etc... "RTN","CASH1",33,0) S I=1,FLNO(1)=FILE "RTN","CASH1",34,0) D F I=2:1 S FLNO(I)=$G(^DD(FLNO(I-1),0,"UP")) Q:FLNO(I)="" Q:$$ISFILE^CASHU(FLNO(I)) D "RTN","CASH1",35,0) .; Get Property Name "RTN","CASH1",36,0) .S NM(I)=$O(^DD(FLNO(I),0,"NM","")) "RTN","CASH1",37,0) .I NM(1)="" S NM(1)=$P($P($G(^DD(FLNO(I),0)),"^",1)," SUB-FIELD",1) "RTN","CASH1",38,0) .Q "RTN","CASH1",39,0) Q:FLNO(I)="" "RTN","CASH1",40,0) ; Get File Type "RTN","CASH1",41,0) S FTYPE="S" "RTN","CASH1",42,0) S PFLD=$O(^DD(FLNO(2),"SB",FLNO(1),"")) "RTN","CASH1",43,0) I PFLD'="",$$FLDATTR^CASHR(FLNO(2),PFLD,"TYPE")="WORD-PROCESSING" S FTYPE="W" "RTN","CASH1",44,0) ; Create name from Root parent name and this sub-files name "RTN","CASH1",45,0) D FILE^CASHF(FLNO(I),.DICNM,.GL) "RTN","CASH1",46,0) F J=I-1:-1:1 S DICNM=DICNM_" "_NM(J) "RTN","CASH1",47,0) ; Get Name "RTN","CASH1",48,0) S NAME=$$NAME^CASHN(DICNM) "RTN","CASH1",49,0) ; Restrict Sub-Name to 20 characters. If used for Simple Names, allow 5 characters for numeric uniqueness "RTN","CASH1",50,0) S SUBNM=$$STDNAME^CASHN(NM(1),20) "RTN","CASH1",51,0) ; Check for rare Sub-name clashes, when the "N" FLAG is used "RTN","CASH1",52,0) ; e.g. File #6.01 - SYNONYM and File #60.1 - SYNONYM would both be called "Synonym601" "RTN","CASH1",53,0) ; This is not a perfect check, as it is not case sensitive. "RTN","CASH1",54,0) ; If necessary a new Uppercase index may need to be added "RTN","CASH1",55,0) I $$SUBEXIST^CASHFN11(SUBNM_$TR(FILE,".","")) F K=0:1 I '$$SUBEXIST^CASHFN11(SUBNM_K_$TR(FILE,".","")) S SUBNM=SUBNM_K Q "RTN","CASH1",56,0) ; Set SQLNM if required "RTN","CASH1",57,0) S SQLNM="" "RTN","CASH1",58,0) ; Check for SQL Reserved words "RTN","CASH1",59,0) I $$SQLRW^CASHU(NAME) S SQLNM="_"_NAME "RTN","CASH1",60,0) ; Create new record for File "RTN","CASH1",61,0) D ADDFILE^CASHFN11(FILE,NAME,SUBNM,SQLNM,FTYPE,PFLD) "RTN","CASH1",62,0) ; "RTN","CASH1",63,0) ; Get Global node and subscripts from top level parent "RTN","CASH1",64,0) S GLOBAL=$P($P(GL,"(",1),"^",2) "RTN","CASH1",65,0) K SUBS "RTN","CASH1",66,0) S SUBS=$P(GL,"(",2) "RTN","CASH1",67,0) S J=0 "RTN","CASH1",68,0) I SUBS'="" F J=1:1:($L(SUBS,",")-1) S SUBS(J)=$P(SUBS,",",J) "RTN","CASH1",69,0) S J=J+1 "RTN","CASH1",70,0) ; Add pointer to this file "RTN","CASH1",71,0) S SUBS(J)="#"_FLNO(I) "RTN","CASH1",72,0) S J=J+1 "RTN","CASH1",73,0) ; Loop through children for subsequent subscripts "RTN","CASH1",74,0) F I=(I-1):-1:1 D "RTN","CASH1",75,0) .S FLD=$O(^DD(FLNO(I+1),"SB",FLNO(I),"")) "RTN","CASH1",76,0) .; Try to allow for missing "SB" levels! "RTN","CASH1",77,0) .I FLD="" D "RTN","CASH1",78,0) ..S FLD=0 "RTN","CASH1",79,0) ..F S FLD=$O(^DD(FLNO(I+1),FLD)) Q:'+FLD I +$P($G(^DD(FLNO(I+1),FLD,0)),"^",2)=FLNO(I) Q "RTN","CASH1",80,0) ..Q "RTN","CASH1",81,0) .S SUBS(J)=$P($P(^DD(FLNO(I+1),FLD,0),"^",4),";",1) "RTN","CASH1",82,0) .S J=J+1 "RTN","CASH1",83,0) .; Don't add pointer for bottom level (this is added for each Map below) "RTN","CASH1",84,0) .I I=1 Q "RTN","CASH1",85,0) .; Add pointer to this file "RTN","CASH1",86,0) .S SUBS(J)="#"_FLNO(I) "RTN","CASH1",87,0) .S J=J+1 "RTN","CASH1",88,0) .Q "RTN","CASH1",89,0) Q "RTN","CASH1",90,0) ; "RTN","CASH1",91,0) MMAP(FILE,UID,GLOBAL,SUBS) ; Add Master Map "RTN","CASH1",92,0) N I "RTN","CASH1",93,0) ; Master Map must have ID=1 and TYPE="D" (data) "RTN","CASH1",94,0) D ADDMAP^CASHFN11(FILE,1,"Master","D",GLOBAL) "RTN","CASH1",95,0) ; Loop through and add Subscripts "RTN","CASH1",96,0) F I=1:1 Q:'$D(SUBS(I)) D "RTN","CASH1",97,0) .; Check if reference to parent file, and add Loop Init Value and Stop Expression "RTN","CASH1",98,0) .I SUBS(I)?1"#".N.(1"."1.N) D ADDSUBS^CASHFN11(FILE,1,I,SUBS(I),0,"'+{L"_I_"}","","") Q "RTN","CASH1",99,0) .D ADDSUBS^CASHFN11(FILE,1,I,SUBS(I),"","","","") "RTN","CASH1",100,0) .Q "RTN","CASH1",101,0) ; Add UID for this file as final Subscript "RTN","CASH1",102,0) D ADDSUBS^CASHFN11(FILE,1,I,UID,0,"'+{L"_I_"}","","") "RTN","CASH1",103,0) Q "RTN","CASH1",104,0) ; "RTN","CASH1",105,0) NEWINX(FILE,NIX,NIXF) ; Create array of New Type Indexes and Fields "RTN","CASH1",106,0) N MAPNM,NIXFLD,NIXNM,NIXREC,NIXSB,NIXSBREC,NIXTMP,OK "RTN","CASH1",107,0) K NIX,NIXF "RTN","CASH1",108,0) ; Loop through New-Style Index "B" cross reference for the specified FILE "RTN","CASH1",109,0) S NIX="" "RTN","CASH1",110,0) F S NIX=$O(^DD("IX","B",FILE,NIX)) Q:NIX="" D "RTN","CASH1",111,0) .; Get New-Style Index Details "RTN","CASH1",112,0) .S NIXREC=^DD("IX",NIX,0) "RTN","CASH1",113,0) .; Quit if not Regular Index "RTN","CASH1",114,0) .I $P(NIXREC,"^",4)'="R" Q "RTN","CASH1",115,0) .; Get Index identifier (e.g. "C") and Map Name "RTN","CASH1",116,0) .S NIXNM=$P(NIXREC,"^",2) "RTN","CASH1",117,0) .S MAPNM=$P(NIXREC,"^",3) "RTN","CASH1",118,0) .; Standardize Map Name "RTN","CASH1",119,0) .S MAPNM=$$STDNAME^CASHN(MAPNM) "RTN","CASH1",120,0) .; Create Temp array "RTN","CASH1",121,0) .K NIXTMP "RTN","CASH1",122,0) .S NIXTMP("NIX")=MAPNM_"^"""_NIXNM_"""" "RTN","CASH1",123,0) .; Loop through Fields "RTN","CASH1",124,0) .S NIXSB=0,OK=1 "RTN","CASH1",125,0) .F S NIXSB=$O(^DD("IX",NIX,11.1,NIXSB)) Q:'+NIXSB D Q:'OK "RTN","CASH1",126,0) ..S NIXSBREC=^DD("IX",NIX,11.1,NIXSB,0) "RTN","CASH1",127,0) ..; Only map Indexes that contain just Fields "RTN","CASH1",128,0) ..I $P(NIXSBREC,"^",2)'="F" S OK=0 Q "RTN","CASH1",129,0) ..I $P(NIXSBREC,"^",3)'=FILE S OK=0 Q "RTN","CASH1",130,0) ..S NIXFLD=$P(NIXSBREC,"^",4) "RTN","CASH1",131,0) ..; Check that the field is valid "RTN","CASH1",132,0) ..I NIXFLD="" S OK=0 Q "RTN","CASH1",133,0) ..I '$D(^DD(FILE,NIXFLD)) S OK=0 Q "RTN","CASH1",134,0) ..; Add field details to NIXTMP "RTN","CASH1",135,0) ..S NIXTMP("NIX",NIXSB)=NIXFLD "RTN","CASH1",136,0) ..S NIXTMP("FLD",NIXFLD)="" "RTN","CASH1",137,0) ..Q "RTN","CASH1",138,0) .; Quit if Index not OK "RTN","CASH1",139,0) .I 'OK Q "RTN","CASH1",140,0) .; Merge Temp array to NIX and NIXF (passed by reference) "RTN","CASH1",141,0) .M NIX(NIX)=NIXTMP("NIX") "RTN","CASH1",142,0) .M NIXF=NIXTMP("FLD") "RTN","CASH1",143,0) .Q "RTN","CASH1",144,0) Q "RTN","CASH1",145,0) ; "RTN","CASH1",146,0) NEWINXU(FILE,UID,GLOBAL,MAP,SUBS,NIX,NIXF) ; Create New Type Indexes "RTN","CASH1",147,0) N ALTEXP,DATALBL,I,MAPNM,NIXFLD,NIXNM "RTN","CASH1",148,0) ; Loop through and add any New-Style Indexes "RTN","CASH1",149,0) S NIX="" "RTN","CASH1",150,0) F S NIX=$O(NIX(NIX)) Q:NIX="" D "RTN","CASH1",151,0) .S MAPNM=$P(NIX(NIX),"^",1) "RTN","CASH1",152,0) .S NIXNM=$P(NIX(NIX),"^",2) "RTN","CASH1",153,0) .; Check MAPNM is unique! "RTN","CASH1",154,0) .I $D(^CASH(15050.11,FILE,3,"B",MAPNM)) F I=0:1 I '$D(^CASH(15050.11,FILE,3,"B",MAPNM_I)) S MAPNM=MAPNM_I Q "RTN","CASH1",155,0) .; Increment Map ID "RTN","CASH1",156,0) .S MAP=MAP+1 "RTN","CASH1",157,0) .; Create new Map, must be of TYPE="I" (index) "RTN","CASH1",158,0) .D ADDMAP^CASHFN11(FILE,MAP,MAPNM,"I",GLOBAL) "RTN","CASH1",159,0) .; Loop through and add initial Subscripts (from parent files) "RTN","CASH1",160,0) .F I=1:1 Q:'$D(SUBS(I)) D ADDSUBS^CASHFN11(FILE,MAP,I,SUBS(I),"","","","") "RTN","CASH1",161,0) .; Add Subscript for Index identifier (e.g. "C") "RTN","CASH1",162,0) .D ADDSUBS^CASHFN11(FILE,MAP,I,NIXNM,"","","","") "RTN","CASH1",163,0) .; Loop through and add New-Style Index Field Subscripts "RTN","CASH1",164,0) .S NIXF="" "RTN","CASH1",165,0) .F S NIXF=$O(NIX(NIX,NIXF)) Q:NIXF="" D "RTN","CASH1",166,0) ..S NIXFLD=NIX(NIX,NIXF) "RTN","CASH1",167,0) ..S DATALBL=$P(NIXF(NIXFLD),"^",1) "RTN","CASH1",168,0) ..S ALTEXP=$P(NIXF(NIXFLD),"^",2) "RTN","CASH1",169,0) ..S:ALTEXP'="" ALTEXP="{"_ALTEXP_"}" "RTN","CASH1",170,0) ..S I=I+1 "RTN","CASH1",171,0) ..D ADDSUBS^CASHFN11(FILE,MAP,I,"{"_DATALBL_"}","","",NIXFLD,ALTEXP) "RTN","CASH1",172,0) ..Q "RTN","CASH1",173,0) .; Add UID for this file as final Subscript "RTN","CASH1",174,0) .D ADDSUBS^CASHFN11(FILE,MAP,I+1,UID,"","","","") "RTN","CASH1",175,0) .Q "RTN","CASH1",176,0) Q "RTN","CASH2") 0^4^B69666901 "RTN","CASH2",1,0) CASH2 ;;ALB/MGC - FileMan Class Map Utility - Internal Calls (Field Discovery) ; 11/15/04@3:00:00 "RTN","CASH2",2,0) ;;1.0;FM TO CACHE SQL;;Jul 08, 2005 "RTN","CASH2",3,0) ; "RTN","CASH2",4,0) FIELDS(FILE,FLAGS,NAME,SUBNM,UID,GLOBAL,MAP,SUBS,NIXF) ; Add Fields "RTN","CASH2",5,0) N MUL,FIELD "RTN","CASH2",6,0) ; Initialise FIELD array with potential UID name to prevent clashes "RTN","CASH2",7,0) S FIELD($$UP^XLFSTR(NAME_"ID"))=0 "RTN","CASH2",8,0) I SUBNM'="" S FIELD($$UP^XLFSTR(SUBNM_"ID"))=0 "RTN","CASH2",9,0) S FIELD("IEN")=0 ; IEN created as UID if FLAGS["I" "RTN","CASH2",10,0) S FIELD("IENS")=0 ; IENS field created by default "RTN","CASH2",11,0) ; "RTN","CASH2",12,0) ; Loop through Fields "RTN","CASH2",13,0) S FIELD=0 "RTN","CASH2",14,0) F S FIELD=$O(^DD(FILE,FIELD)) Q:'+FIELD I $D(^DD(FILE,FIELD,0)) D "RTN","CASH2",15,0) .N DATALBL,DDLBL,DECD,DESC,DUP,EXT1,EXT2,GSL,INDEXED,INP,LABEL,LBLUP,LEN,MULT,NODE,OUT "RTN","CASH2",16,0) .N PIECE,PNTR,REQ,RCODE,SPEC,SQLLBL,TRANS,TYPE "RTN","CASH2",17,0) .; Get Field details "RTN","CASH2",18,0) .D FIELD^CASHF(FILE,FIELD,.DDLBL,.SPEC,.DECD,.TYPE,.MULT,.PNTR,.GSL,.INP,.OUT,.LEN) "RTN","CASH2",19,0) .; Standardise the Name "RTN","CASH2",20,0) .S LABEL=$$STDNAME^CASHN(DDLBL) "RTN","CASH2",21,0) .Q:LABEL="" "RTN","CASH2",22,0) .; Create Description for Property "RTN","CASH2",23,0) .S DESC="Field #: "_FIELD_" Name: "_DDLBL "RTN","CASH2",24,0) .; Set Required flag "RTN","CASH2",25,0) .S REQ=$S(SPEC["R":1,1:0) "RTN","CASH2",26,0) .;Field .001 is a Special Case! "RTN","CASH2",27,0) .;It returns the IEN, which will already be mapped. "RTN","CASH2",28,0) .I FIELD=.001 D Q "RTN","CASH2",29,0) ..N LSUB "RTN","CASH2",30,0) ..; Check for duplicate LABEL "RTN","CASH2",31,0) ..S LBLUP=$$UP^XLFSTR(LABEL) "RTN","CASH2",32,0) ..I $D(FIELD(LBLUP)) N J F J=0:1 I '$D(FIELD(LBLUP_J)) S LABEL=LABEL_J,LBLUP=LBLUP_J Q "RTN","CASH2",33,0) ..S FIELD(LBLUP)=.001 "RTN","CASH2",34,0) ..; Get SQL and Data labels "RTN","CASH2",35,0) ..D LABELS(LABEL,.SQLLBL,.DATALBL) "RTN","CASH2",36,0) ..; Get the last Subscript level "RTN","CASH2",37,0) ..S LSUB=$O(SUBS(""),-1) "RTN","CASH2",38,0) ..; The IEN will be at the next level - create appropriate Retrieval Code "RTN","CASH2",39,0) ..S RCODE=" S {*}={L"_(LSUB+1)_"}" "RTN","CASH2",40,0) ..; Special Case for Date/Time fields "RTN","CASH2",41,0) ..I TYPE="DATE/TIME" D DT^CASH3(FILE,FIELD,LABEL,DESC,REQ,SQLLBL,DATALBL,"","",RCODE,INP) Q "RTN","CASH2",42,0) ..; Add Field as %Float for all other cases "RTN","CASH2",43,0) ..D ADDFLD^CASHFN11(FILE,FIELD,LABEL,0,"","",DESC,"",0,REQ,"",0,"%Library.Float","T",SQLLBL) "RTN","CASH2",44,0) ..D ADDDATA^CASHFN11(FILE,1,FIELD,DATALBL,"","",0,RCODE) "RTN","CASH2",45,0) ..Q "RTN","CASH2",46,0) .; Remove characters from SPEC not to do with data extraction "RTN","CASH2",47,0) .S SPEC=$TR(SPEC,"aeAILMO'RX*","") "RTN","CASH2",48,0) .; Set Output Transform flag "RTN","CASH2",49,0) .S TRANS=$S(OUT'="":1,1:0) "RTN","CASH2",50,0) .; Check for Numeric values with Transforms (must be exposed as String/Varchar) "RTN","CASH2",51,0) .I TYPE="NUMERIC",TRANS S TYPE="FREE TEXT" "RTN","CASH2",52,0) .; Check that Pointer is Valid, and Discover pointed to File "RTN","CASH2",53,0) .; (Note: Discovery has been moved up to here to help prevent errors) "RTN","CASH2",54,0) .I TYPE="POINTER" D "RTN","CASH2",55,0) ..N PFILE,PFLAGS,SUCCESS "RTN","CASH2",56,0) ..S PFILE=+$P(SPEC,"P",2) "RTN","CASH2",57,0) ..; Check for Invalid Pointers "RTN","CASH2",58,0) ..I 'PFILE S TYPE="FREE TEXT" Q "RTN","CASH2",59,0) ..; Check for Pointers to non-existent files! "RTN","CASH2",60,0) ..I '$$ISFILE^CASHU(PFILE) S TYPE="FREE TEXT" Q "RTN","CASH2",61,0) ..; Discover Pointed to File if P passed in FLAGS "RTN","CASH2",62,0) ..I FLAGS'["P" Q "RTN","CASH2",63,0) ..; Prevent Pointed to Classes from being Compiled "RTN","CASH2",64,0) ..; If P passed in FLAGS they will be compiled by CASHC "RTN","CASH2",65,0) ..S PFLAGS=$TR(FLAGS,"C","") "RTN","CASH2",66,0) ..; If R not passed in FLAGS don't expand Multiples or Pointers in pointed to File "RTN","CASH2",67,0) ..I FLAGS'["R" S PFLAGS=$TR(PFLAGS,"MP","") "RTN","CASH2",68,0) ..I '$$DISCVR^CASH0(PFILE,PFLAGS) S TYPE="FREE TEXT" "RTN","CASH2",69,0) ..Q "RTN","CASH2",70,0) .; Check for Sets of Codes with Transforms (unless INPUT TRANSFORM defined set TRANS=0) "RTN","CASH2",71,0) .I TYPE="SET",TRANS,INP="Q" S TRANS=0 "RTN","CASH2",72,0) .; Check for Free Text with Transforms (if transform requires DA or D0 set TRANS=0) "RTN","CASH2",73,0) .I TYPE="FREE TEXT",TRANS,INP["DA"!(INP["D0")!(OUT["DA")!(OUT["D0") S TRANS=0 "RTN","CASH2",74,0) .; Check for Multiples that have already been specified - can't have two Relationships to the same file! "RTN","CASH2",75,0) .I MULT,$D(MUL(+SPEC)) Q "RTN","CASH2",76,0) .; Check for Multiples to non-existant Sub-Files "RTN","CASH2",77,0) .I MULT,'$D(^DD(+SPEC)) Q "RTN","CASH2",78,0) .; Get Global Data details "RTN","CASH2",79,0) .S NODE=$P(GSL,";",1) "RTN","CASH2",80,0) .I NODE'=+NODE S NODE=""""_NODE_"""" "RTN","CASH2",81,0) .S PIECE=$P(GSL,";",2) "RTN","CASH2",82,0) .; Check for invalid Piece # (cannot be greater than 123) - set to last good piece for node +1 "RTN","CASH2",83,0) .I PIECE>123 F S PIECE=$O(^DD(FILE,"GL",NODE,PIECE),-1) I PIECE<123 S PIECE=PIECE+1 Q "RTN","CASH2",84,0) .S (RCODE,EXT1,EXT2)="" "RTN","CASH2",85,0) .; If data is not $Piece "RTN","CASH2",86,0) .I $E(PIECE)="E" D "RTN","CASH2",87,0) ..N GLREF,I,SUBSNO "RTN","CASH2",88,0) ..S SUBSNO=$O(SUBS(""),-1)+1 "RTN","CASH2",89,0) ..S GLREF="^"_GLOBAL_"({L1}" "RTN","CASH2",90,0) ..; Add all the subscripts "RTN","CASH2",91,0) ..F I=2:1:SUBSNO S GLREF=GLREF_",{L"_I_"}" "RTN","CASH2",92,0) ..; Add the node "RTN","CASH2",93,0) ..S GLREF=GLREF_","_NODE_")" "RTN","CASH2",94,0) ..; Get Extract lengths "RTN","CASH2",95,0) ..S EXT1=$E($P(PIECE,",",1),2,255) "RTN","CASH2",96,0) ..S EXT2=$P(PIECE,",",2) S:EXT2="" EXT2=245 "RTN","CASH2",97,0) ..; Set the Retrieval Code string "RTN","CASH2",98,0) ..S RCODE=" S {*}=$E($G("_GLREF_"),"_EXT1_","_EXT2_")" "RTN","CASH2",99,0) ..S (NODE,PIECE)="" "RTN","CASH2",100,0) ..Q "RTN","CASH2",101,0) .; Check for Duplicate fields and/or Labels "RTN","CASH2",102,0) .S DUP=0,LBLUP=$$UP^XLFSTR(LABEL) "RTN","CASH2",103,0) .I $D(FIELD(LBLUP)) D Q:DUP "RTN","CASH2",104,0) ..N DUPDATA,DUPFLD,DUPRCD,J "RTN","CASH2",105,0) ..S DUPFLD=FIELD(LBLUP) "RTN","CASH2",106,0) ..; Get Data record (File #15050.1132 - Node 0) from Master map (Map #1) "RTN","CASH2",107,0) ..S DUPDATA=$G(^CASH(15050.11,FILE,3,1,2,DUPFLD,0)) "RTN","CASH2",108,0) ..; Get Retrieval Code if it exists (Node 1) "RTN","CASH2",109,0) ..S DUPRCD=$G(^CASH(15050.11,FILE,3,1,2,DUPFLD,1)) "RTN","CASH2",110,0) ..; If all these values are the same, the Field is a complete Duplicate - Skip "RTN","CASH2",111,0) ..I NODE=$P(DUPDATA,"^",2),PIECE=$P(DUPDATA,"^",3),RCODE=DUPRCD S DUP=1 Q "RTN","CASH2",112,0) ..; Append # to LABEL to prevent duplicate names "RTN","CASH2",113,0) ..F J=0:1 I '$D(FIELD(LBLUP_J)) S LABEL=LABEL_J,LBLUP=LBLUP_J Q "RTN","CASH2",114,0) ..Q "RTN","CASH2",115,0) .; Check for potential clash with UID field "RTN","CASH2",116,0) .I MULT!(TYPE="POINTER"),LBLUP=$$UP^XLFSTR(NAME)!($D(FIELD(LBLUP_"ID"))) N J F J=0:1 I '$D(FIELD(LBLUP_J)),'$D(FIELD(LBLUP_J_"ID")) S LABEL=LABEL_J,LBLUP=LBLUP_J Q "RTN","CASH2",117,0) .; Set FIELD array values (also set "ID" for Multiples and Pointers) "RTN","CASH2",118,0) .S FIELD(LBLUP)=FIELD "RTN","CASH2",119,0) .I MULT!(TYPE="POINTER") S FIELD(LBLUP_"ID")=FIELD "RTN","CASH2",120,0) .; Get SQL and Data labels "RTN","CASH2",121,0) .D LABELS(LABEL,.SQLLBL,.DATALBL) "RTN","CASH2",122,0) .; "RTN","CASH2",123,0) .; Initialize INDEXED flag "RTN","CASH2",124,0) .S INDEXED=0 "RTN","CASH2",125,0) .; If FIELD is in a New type index, update INDEXED flag and add DATALBL to NIXF array "RTN","CASH2",126,0) .I $D(NIXF(FIELD)) S INDEXED=1,NIXF(FIELD)=DATALBL_$S(TYPE="POINTER":"^"_LABEL_"ID",1:"") "RTN","CASH2",127,0) .; Add any Traditional Indexes "RTN","CASH2",128,0) .I $D(^DD(FILE,FIELD,1)),'MULT D "RTN","CASH2",129,0) ..N DUPCHK,INX "RTN","CASH2",130,0) ..S INX=0 "RTN","CASH2",131,0) ..F S INX=$O(^DD(FILE,FIELD,1,INX)) Q:'+INX I $D(^DD(FILE,FIELD,1,INX,0)) D "RTN","CASH2",132,0) ...N ALTEXP,I,INXFN,INXNM,INXTP,MAPNM "RTN","CASH2",133,0) ...S ALTEXP=$S(TYPE="POINTER":"{"_LABEL_"ID}",1:"") "RTN","CASH2",134,0) ...S INXFN=$P($G(^DD(FILE,FIELD,1,INX,0)),"^",1) "RTN","CASH2",135,0) ...S INXNM=$P($G(^DD(FILE,FIELD,1,INX,0)),"^",2) "RTN","CASH2",136,0) ...Q:INXNM="" "RTN","CASH2",137,0) ...; Check that Index is Regular (don't map KWIC, MNEMONIC, etc...) "RTN","CASH2",138,0) ...S INXTP=$P(^DD(FILE,FIELD,1,INX,0),"^",3) "RTN","CASH2",139,0) ...Q:INXTP'="" "RTN","CASH2",140,0) ...; Check that Index isn't a duplicate "RTN","CASH2",141,0) ...I $D(DUPCHK(INXNM)) Q "RTN","CASH2",142,0) ...S DUPCHK(INXNM)="" "RTN","CASH2",143,0) ...; Increment Map count and get Map Name "RTN","CASH2",144,0) ...S MAP=MAP+1 "RTN","CASH2",145,0) ...S MAPNM=LABEL_INXNM_"Index" "RTN","CASH2",146,0) ...S INDEXED=1 "RTN","CASH2",147,0) ...D ADDMAP^CASHFN11(FILE,MAP,MAPNM,"I",GLOBAL) "RTN","CASH2",148,0) ...I INXFN'=FILE D Q "RTN","CASH2",149,0) ....N J "RTN","CASH2",150,0) ....F I=1:1 Q:'$D(SUBS(I)) Q:SUBS(I)=("#"_INXFN) D ADDSUBS^CASHFN11(FILE,MAP,I,SUBS(I),"","","","") "RTN","CASH2",151,0) ....S J=I "RTN","CASH2",152,0) ....D ADDSUBS^CASHFN11(FILE,MAP,J,""""_INXNM_"""","","","","") S J=J+1 "RTN","CASH2",153,0) ....D ADDSUBS^CASHFN11(FILE,MAP,J,"{"_DATALBL_"}","","",FIELD,ALTEXP) S J=J+1 "RTN","CASH2",154,0) ....F I=I:1 Q:'$D(SUBS(I)) I $E(SUBS(I))="#" D ADDSUBS^CASHFN11(FILE,MAP,J,SUBS(I),"","","","") S J=J+1 "RTN","CASH2",155,0) ....D ADDSUBS^CASHFN11(FILE,MAP,J,UID,"","","","") "RTN","CASH2",156,0) ....Q "RTN","CASH2",157,0) ...F I=1:1 Q:'$D(SUBS(I)) D ADDSUBS^CASHFN11(FILE,MAP,I,SUBS(I),"","","","") "RTN","CASH2",158,0) ...D ADDSUBS^CASHFN11(FILE,MAP,I,""""_INXNM_"""","","","","") "RTN","CASH2",159,0) ...D ADDSUBS^CASHFN11(FILE,MAP,I+1,"{"_DATALBL_"}","","",FIELD,ALTEXP) "RTN","CASH2",160,0) ...D ADDSUBS^CASHFN11(FILE,MAP,I+2,UID,"","","","") "RTN","CASH2",161,0) ...Q "RTN","CASH2",162,0) ..Q "RTN","CASH2",163,0) .; "RTN","CASH2",164,0) .; Now Add Field definitions "RTN","CASH2",165,0) .I MULT D MULT^CASH3(FILE,FIELD,LABEL,DESC,REQ,SQLLBL,DATALBL,SPEC,FLAGS,NAME,TYPE,.SUBS,.MUL) Q "RTN","CASH2",166,0) .I TYPE="DATE/TIME" D DT^CASH3(FILE,FIELD,LABEL,DESC,REQ,SQLLBL,DATALBL,NODE,PIECE,RCODE,INP) Q "RTN","CASH2",167,0) .I TYPE="NUMERIC" D NUM^CASH3(FILE,FIELD,LABEL,DESC,REQ,SQLLBL,DATALBL,NODE,PIECE,RCODE,INP,DECD) Q "RTN","CASH2",168,0) .I TYPE="SET" D SET^CASH3(FILE,FIELD,LABEL,DESC,REQ,SQLLBL,DATALBL,NODE,PIECE,RCODE,TRANS) Q "RTN","CASH2",169,0) .I TYPE="FREE TEXT" D FREE^CASH3(FILE,FIELD,LABEL,DESC,REQ,SQLLBL,DATALBL,NODE,PIECE,RCODE,INP,TRANS,INDEXED) Q "RTN","CASH2",170,0) .I TYPE="WORD-PROCESSING" D WP^CASH3(FILE,FIELD,LABEL,DESC,REQ,SQLLBL,DATALBL,NODE,RCODE,GLOBAL,INDEXED,.SUBS) Q "RTN","CASH2",171,0) .I TYPE="COMPUTED" D COMP^CASH3(FILE,FIELD,LABEL,DESC,REQ,SQLLBL,SPEC,DDLBL) Q "RTN","CASH2",172,0) .I TYPE="POINTER" D PNTR^CASH3(FILE,FIELD,LABEL,DESC,REQ,SQLLBL,DATALBL,NODE,PIECE,RCODE,SPEC,FLAGS) Q "RTN","CASH2",173,0) .I TYPE="VARIABLE-POINTER" D VP^CASH3(FILE,FIELD,LABEL,DESC,REQ,SQLLBL,DATALBL,NODE,PIECE,RCODE) Q "RTN","CASH2",174,0) .I TYPE="MUMPS" D MUMPS^CASH3(FILE,FIELD,LABEL,DESC,REQ,SQLLBL,DATALBL,RCODE,EXT2,INDEXED) Q "RTN","CASH2",175,0) Q "RTN","CASH2",176,0) ; "RTN","CASH2",177,0) LABELS(LABEL,SQLLBL,DATALBL) ; Get SQL and Data labels "RTN","CASH2",178,0) S SQLLBL="" "RTN","CASH2",179,0) ; Check for SQL Reserved words "RTN","CASH2",180,0) I $$SQLRW^CASHU(LABEL) S SQLLBL=LABEL_"_" "RTN","CASH2",181,0) ; Set Label used for Data Nodes. Use SQLLBL if defined! "RTN","CASH2",182,0) ; Note: Classes use %CacheSQLStorage, so SQL Field Names are used in SQL Storage Maps "RTN","CASH2",183,0) S DATALBL=$S(SQLLBL="":LABEL,1:SQLLBL) "RTN","CASH2",184,0) Q "RTN","CASH3") 0^5^B74243014 "RTN","CASH3",1,0) CASH3 ;;ALB/MGC - FileMan Class Map Utility - Internal Calls (Fields contd...) ; 11/15/04@3:00:00 "RTN","CASH3",2,0) ;;1.0;FM TO CACHE SQL;;Jul 08, 2005 "RTN","CASH3",3,0) ; "RTN","CASH3",4,0) ; Multiples "RTN","CASH3",5,0) ; Discover Sub-file "RTN","CASH3",6,0) ; "RTN","CASH3",7,0) MULT(FILE,FIELD,LABEL,DESC,REQ,SQLLBL,DATALBL,SPEC,FLAGS,NAME,TYPE,SUBS,MUL) ; "RTN","CASH3",8,0) N CFLAGS,CHILD,CLBL,I,SUCCESS "RTN","CASH3",9,0) S CHILD=+SPEC "RTN","CASH3",10,0) ; Check "UP" pointer of sub-file matches the parent "RTN","CASH3",11,0) ; Do not map if corrupt! "RTN","CASH3",12,0) I $G(^DD(CHILD,0,"UP"))'=FILE W:FLAGS["V" !,"Invalid UP pointer for File #",CHILD," - Field #",FIELD," in File #",FILE," not mapped!",! Q "RTN","CASH3",13,0) ; Discover Sub-file "RTN","CASH3",14,0) ; Remove C from CFLAGS to stop any embedded classes being compiled at this stage "RTN","CASH3",15,0) ; Sub-classes themselves are only compiled through their Super-class "RTN","CASH3",16,0) S CFLAGS=$TR(FLAGS,"C","") "RTN","CASH3",17,0) ; If R or r not passed in FLAGS don't expand Pointers in Sub-file "RTN","CASH3",18,0) I FLAGS'["R",FLAGS'["r" S CFLAGS=$TR(FLAGS,"P","") "RTN","CASH3",19,0) ; Recursive Call "RTN","CASH3",20,0) S SUCCESS=$$DISCVR^CASH0(CHILD,CFLAGS) "RTN","CASH3",21,0) Q:'SUCCESS "RTN","CASH3",22,0) ; Set MULT array to prevent more than one Relationship to the same file "RTN","CASH3",23,0) S MUL(CHILD)="" "RTN","CASH3",24,0) ; Word Processing options "RTN","CASH3",25,0) I TYPE="WORD-PROCESSING" D "RTN","CASH3",26,0) .; Create a single serialized field for the Word Processing multiple "RTN","CASH3",27,0) .D WPSERIAL^CASH3(FILE,FIELD,LABEL,DESC,REQ,SQLLBL,DATALBL,.SUBS) "RTN","CASH3",28,0) .; Increment the FIELD # so the Relationship Property doesn't clash "RTN","CASH3",29,0) .S FIELD=FIELD+0.0000001 "RTN","CASH3",30,0) .Q "RTN","CASH3",31,0) S LABEL=LABEL_"ID" "RTN","CASH3",32,0) S CLBL=NAME_"ID" "RTN","CASH3",33,0) I $$FNMEXIST^CASHFN11(CHILD,CLBL) F I=0:1 S CLBL=NAME_I_"ID" Q:'$$FNMEXIST^CASHFN11(CHILD,CLBL) "RTN","CASH3",34,0) ; Create Relationship field for this file (FILE) "RTN","CASH3",35,0) S DESC="Relationship To Child File #: "_CHILD_" ("_DESC_")" "RTN","CASH3",36,0) D ADDFLD^CASHFN11(FILE,FIELD,LABEL,0,"C","",DESC,CLBL,1,REQ,"",0,"#"_CHILD,"M","") "RTN","CASH3",37,0) ; Create Inverse Relationship field in the Multiple (CHILD) "RTN","CASH3",38,0) ; Use 15050.111 as the Field # as this should be unique! This Property does not exist in FileMan! "RTN","CASH3",39,0) S DESC="Relationship To Parent File #: "_FILE "RTN","CASH3",40,0) D ADDFLD^CASHFN11(CHILD,15050.111,CLBL,0,"P","",DESC,LABEL,1,1,"",0,"#"_FILE,"C","") "RTN","CASH3",41,0) ; Create Sub File relationship "RTN","CASH3",42,0) D ADDSUBF^CASHFN11(FILE,CHILD) "RTN","CASH3",43,0) Q "RTN","CASH3",44,0) ; "RTN","CASH3",45,0) ; 1. Date/Time "RTN","CASH3",46,0) ; "RTN","CASH3",47,0) DT(FILE,FIELD,LABEL,DESC,REQ,SQLLBL,DATALBL,NODE,PIECE,RCODE,INP) ; "RTN","CASH3",48,0) N CAT,DT,PTYPE "RTN","CASH3",49,0) ; Make Transient if Special .001 field "RTN","CASH3",50,0) S CAT=$S(FIELD=.001:"T",1:"D") "RTN","CASH3",51,0) S DT=$P($P(INP,"S %DT=",2)," D ^%DT",1) "RTN","CASH3",52,0) ; Extract Flags from quotes (and remove any extraneous code) "RTN","CASH3",53,0) S DT=$P(DT,"""",2) "RTN","CASH3",54,0) ; Remove "E" from DT (E has a different meaning in ^%DT and DT^DILF) "RTN","CASH3",55,0) S DT=$TR(DT,"E") "RTN","CASH3",56,0) S PTYPE="CASH.FileMan.StringDateTime" "RTN","CASH3",57,0) I DT["X" D "RTN","CASH3",58,0) .I DT["T"!(DT["R") S PTYPE="CASH.FileMan.DateTime" Q "RTN","CASH3",59,0) .S PTYPE="CASH.FileMan.Date" "RTN","CASH3",60,0) .Q "RTN","CASH3",61,0) ; Add Field "RTN","CASH3",62,0) D ADDFLD^CASHFN11(FILE,FIELD,LABEL,0,"","",DESC,"",0,REQ,"",0,PTYPE,CAT,SQLLBL) "RTN","CASH3",63,0) ; Add Parameters "RTN","CASH3",64,0) D ADDPARAM^CASHFN11(FILE,FIELD,1,"FILE",FILE) "RTN","CASH3",65,0) D ADDPARAM^CASHFN11(FILE,FIELD,2,"FIELD",FIELD) "RTN","CASH3",66,0) D ADDPARAM^CASHFN11(FILE,FIELD,3,"FLAGS",DT) "RTN","CASH3",67,0) D ADDPARAM^CASHFN11(FILE,FIELD,4,"TRANSFORM",0) "RTN","CASH3",68,0) ; Add to Master Map Data "RTN","CASH3",69,0) D ADDDATA^CASHFN11(FILE,1,FIELD,DATALBL,NODE,PIECE,0,RCODE) "RTN","CASH3",70,0) Q "RTN","CASH3",71,0) ; "RTN","CASH3",72,0) ; 2. Numeric "RTN","CASH3",73,0) ; "RTN","CASH3",74,0) NUM(FILE,FIELD,LABEL,DESC,REQ,SQLLBL,DATALBL,NODE,PIECE,RCODE,INP,DECD) ; "RTN","CASH3",75,0) N I,MAX,MIN,PTYPE "RTN","CASH3",76,0) S PTYPE="CASH.FileMan.Numeric" "RTN","CASH3",77,0) ; Add Field "RTN","CASH3",78,0) D ADDFLD^CASHFN11(FILE,FIELD,LABEL,0,"","",DESC,"",0,REQ,"",0,PTYPE,"D",SQLLBL) "RTN","CASH3",79,0) ; Add Parameters "RTN","CASH3",80,0) S MAX=+$P($P(INP,"K:+X'=X!(X>",2),")",1) "RTN","CASH3",81,0) S MIN=+$P($P(INP,"!(X<",2),")",1) "RTN","CASH3",82,0) D ADDPARAM^CASHFN11(FILE,FIELD,1,"FILE",FILE) "RTN","CASH3",83,0) D ADDPARAM^CASHFN11(FILE,FIELD,2,"FIELD",FIELD) "RTN","CASH3",84,0) S I=3 "RTN","CASH3",85,0) I MAX'=0 D ADDPARAM^CASHFN11(FILE,FIELD,I,"MAXVAL",MAX) S I=I+1 "RTN","CASH3",86,0) I MIN'=0 D ADDPARAM^CASHFN11(FILE,FIELD,I,"MINVAL",MIN) S I=I+1 "RTN","CASH3",87,0) D ADDPARAM^CASHFN11(FILE,FIELD,I,"SCALE",+DECD) "RTN","CASH3",88,0) ; Add to Master Map Data "RTN","CASH3",89,0) D ADDDATA^CASHFN11(FILE,1,FIELD,DATALBL,NODE,PIECE,0,RCODE) "RTN","CASH3",90,0) Q "RTN","CASH3",91,0) ; "RTN","CASH3",92,0) ; 3. Set Of Codes "RTN","CASH3",93,0) ; "RTN","CASH3",94,0) SET(FILE,FIELD,LABEL,DESC,REQ,SQLLBL,DATALBL,NODE,PIECE,RCODE,TRANS) ; "RTN","CASH3",95,0) N PTYPE "RTN","CASH3",96,0) S PTYPE="CASH.FileMan.SetOfCodes" "RTN","CASH3",97,0) ; Add Field "RTN","CASH3",98,0) D ADDFLD^CASHFN11(FILE,FIELD,LABEL,0,"","",DESC,"",0,REQ,"",0,PTYPE,"D",SQLLBL) "RTN","CASH3",99,0) ; Add Parameters "RTN","CASH3",100,0) D ADDPARAM^CASHFN11(FILE,FIELD,1,"FILE",FILE) "RTN","CASH3",101,0) D ADDPARAM^CASHFN11(FILE,FIELD,2,"FIELD",FIELD) "RTN","CASH3",102,0) D ADDPARAM^CASHFN11(FILE,FIELD,3,"TRANSFORM",TRANS) "RTN","CASH3",103,0) ; Add to Master Map Data "RTN","CASH3",104,0) D ADDDATA^CASHFN11(FILE,1,FIELD,DATALBL,NODE,PIECE,0,RCODE) "RTN","CASH3",105,0) Q "RTN","CASH3",106,0) ; "RTN","CASH3",107,0) ; 4. Free Text "RTN","CASH3",108,0) ; "RTN","CASH3",109,0) FREE(FILE,FIELD,LABEL,DESC,REQ,SQLLBL,DATALBL,NODE,PIECE,RCODE,INP,TRANS,INDEXED) ; "RTN","CASH3",110,0) N I,MAX,MIN,PTYPE "RTN","CASH3",111,0) S PTYPE="CASH.FileMan.String" "RTN","CASH3",112,0) D ADDFLD^CASHFN11(FILE,FIELD,LABEL,0,"","",DESC,"",0,REQ,"",0,PTYPE,"D",SQLLBL) "RTN","CASH3",113,0) ; Add Parameters "RTN","CASH3",114,0) S MAX=+$P($P(INP,"K:$L(X)>",2),"!",1) "RTN","CASH3",115,0) S MIN=+$P($P(INP,"!($L(X)<",2),")",1) "RTN","CASH3",116,0) D ADDPARAM^CASHFN11(FILE,FIELD,1,"FILE",FILE) "RTN","CASH3",117,0) D ADDPARAM^CASHFN11(FILE,FIELD,2,"FIELD",FIELD) "RTN","CASH3",118,0) D ADDPARAM^CASHFN11(FILE,FIELD,3,"TRANSFORM",TRANS) "RTN","CASH3",119,0) S I=4 "RTN","CASH3",120,0) I MAX'=0 D ADDPARAM^CASHFN11(FILE,FIELD,I,"MAXLEN",MAX) S I=I+1 "RTN","CASH3",121,0) I MIN'=0 D ADDPARAM^CASHFN11(FILE,FIELD,I,"MINLEN",MIN) S I=I+1 "RTN","CASH3",122,0) I INDEXED D ADDPARAM^CASHFN11(FILE,FIELD,I,"COLLATION","EXACT") "RTN","CASH3",123,0) ; Add to Master Map Data "RTN","CASH3",124,0) D ADDDATA^CASHFN11(FILE,1,FIELD,DATALBL,NODE,PIECE,0,RCODE) "RTN","CASH3",125,0) Q "RTN","CASH3",126,0) ; "RTN","CASH3",127,0) ; 5. Word Processing "RTN","CASH3",128,0) ; Add Word Processing field "RTN","CASH3",129,0) ; "RTN","CASH3",130,0) WP(FILE,FIELD,LABEL,DESC,REQ,SQLLBL,DATALBL,NODE,RCODE,GLOBAL,INDEXED,SUBS) ; "RTN","CASH3",131,0) N GLREF,I,PTYPE,SUBSNO "RTN","CASH3",132,0) ; If RCODE hasn't been calculated (for fields with GSL=0;E1,250) get it now. "RTN","CASH3",133,0) I RCODE="",NODE'="" D "RTN","CASH3",134,0) .S SUBSNO=$O(SUBS(""),-1)+1 "RTN","CASH3",135,0) .S GLREF="^"_GLOBAL_"({L1}" "RTN","CASH3",136,0) .; Add all the subscripts "RTN","CASH3",137,0) .F I=2:1:SUBSNO S GLREF=GLREF_",{L"_I_"}" "RTN","CASH3",138,0) .; Add the node "RTN","CASH3",139,0) .S GLREF=GLREF_","_NODE_")" "RTN","CASH3",140,0) .; Set the Retrieval Code string "RTN","CASH3",141,0) .S RCODE=" S {*}=$G("_GLREF_")" "RTN","CASH3",142,0) .Q "RTN","CASH3",143,0) S PTYPE="%Library.String" "RTN","CASH3",144,0) ; Add Field "RTN","CASH3",145,0) D ADDFLD^CASHFN11(FILE,FIELD,LABEL,0,"","",DESC,"",0,REQ,"",0,PTYPE,"D",SQLLBL) "RTN","CASH3",146,0) ; Add Parameters "RTN","CASH3",147,0) D ADDPARAM^CASHFN11(FILE,FIELD,1,"MAXLEN",255) "RTN","CASH3",148,0) D ADDPARAM^CASHFN11(FILE,FIELD,2,"MINLEN",1) "RTN","CASH3",149,0) I INDEXED D ADDPARAM^CASHFN11(FILE,FIELD,3,"COLLATION","EXACT") "RTN","CASH3",150,0) ; Add to Master Map Data "RTN","CASH3",151,0) D ADDDATA^CASHFN11(FILE,1,FIELD,DATALBL,"","",0,RCODE) "RTN","CASH3",152,0) Q "RTN","CASH3",153,0) ; "RTN","CASH3",154,0) ; Add Serialized Word Processing field "RTN","CASH3",155,0) ; "RTN","CASH3",156,0) WPSERIAL(FILE,FIELD,LABEL,DESC,REQ,SQLLBL,DATALBL,SUBS) ; "RTN","CASH3",157,0) N I,ID,NO,PTYPE,RCODE "RTN","CASH3",158,0) S PTYPE="CASH.FileMan.String" "RTN","CASH3",159,0) ; Add Field "RTN","CASH3",160,0) D ADDFLD^CASHFN11(FILE,FIELD,LABEL,0,"","",DESC,"",0,REQ,"",0,PTYPE,"W",SQLLBL) "RTN","CASH3",161,0) ; Add Parameters "RTN","CASH3",162,0) D ADDPARAM^CASHFN11(FILE,FIELD,1,"MAXLEN",32767) "RTN","CASH3",163,0) ; Add to Master Map Data "RTN","CASH3",164,0) S NO=$O(SUBS(""),-1) "RTN","CASH3",165,0) S ID="{L"_(NO+1)_"}" "RTN","CASH3",166,0) F I=NO:-1:1 I $E(SUBS(I))="#" S ID="{L"_I_"}"_"_""||""_"_ID "RTN","CASH3",167,0) S RCODE=" S {*}=$$GETWP^CASHR("_FILE_","_FIELD_","_ID_")" "RTN","CASH3",168,0) D ADDDATA^CASHFN11(FILE,1,FIELD,DATALBL,"","",0,RCODE) "RTN","CASH3",169,0) Q "RTN","CASH3",170,0) ; "RTN","CASH3",171,0) ; 6. Computed Field "RTN","CASH3",172,0) ; "RTN","CASH3",173,0) COMP(FILE,FIELD,LABEL,DESC,REQ,SQLLBL,SPEC,DDLBL) ; "RTN","CASH3",174,0) N CODE,COMP,DESCM,PTYPE,SQLCODE "RTN","CASH3",175,0) D ; Get Computed Field Type "RTN","CASH3",176,0) .; If Boolean, use %Library.Boolean with no parameters "RTN","CASH3",177,0) .I SPEC["B" S PTYPE="%Library.Boolean" Q "RTN","CASH3",178,0) .; Add default Parameters "RTN","CASH3",179,0) .D ADDPARAM^CASHFN11(FILE,FIELD,1,"FILE",FILE) "RTN","CASH3",180,0) .D ADDPARAM^CASHFN11(FILE,FIELD,2,"FIELD",FIELD) "RTN","CASH3",181,0) .D ADDPARAM^CASHFN11(FILE,FIELD,3,"TRANSFORM",0) ;Transform done automatically "RTN","CASH3",182,0) .; If Date/Time, use StringDateTime (as we can't divine the exact type) "RTN","CASH3",183,0) .I SPEC["D" S PTYPE="CASH.FileMan.StringDateTime" Q "RTN","CASH3",184,0) .; Add extra parameters for String "RTN","CASH3",185,0) .N MAX "RTN","CASH3",186,0) .S MAX=+$P(SPEC,"J",2) S:MAX=0 MAX=50 "RTN","CASH3",187,0) .D ADDPARAM^CASHFN11(FILE,FIELD,4,"MAXLEN",MAX) "RTN","CASH3",188,0) .D ADDPARAM^CASHFN11(FILE,FIELD,5,"MINLEN",1) "RTN","CASH3",189,0) .S PTYPE="CASH.FileMan.String" "RTN","CASH3",190,0) .Q "RTN","CASH3",191,0) S COMP=$$FLDATTR^CASHR(FILE,FIELD,"COMPUTE ALGORITHM") "RTN","CASH3",192,0) ; Add Field "RTN","CASH3",193,0) S SQLCODE=" S {*}=$$GETDATA^CASHR("_FILE_","_FIELD_",{ID})" "RTN","CASH3",194,0) I COMP["PSET^%ZISP" S SQLCODE=" S {*}=$$GETDTIO^CASHR("_FILE_","_FIELD_",{ID})" "RTN","CASH3",195,0) D ADDFLD^CASHFN11(FILE,FIELD,LABEL,1,"","",DESC,"",0,REQ,SQLCODE,1,PTYPE,"T",SQLLBL) "RTN","CASH3",196,0) ; Add Get() method "RTN","CASH3",197,0) S DESCM="Get() Method for Computed Field #: "_FIELD_" Name: "_DDLBL "RTN","CASH3",198,0) D ADDMTD^CASHFN11(FILE,FIELD,LABEL_"Get",0,"E",DESCM,"",0,"",PTYPE) "RTN","CASH3",199,0) S CODE(1,0)="$$GETDATA^CASHR("_FILE_","_FIELD_",..%Id())" "RTN","CASH3",200,0) I COMP["PSET^%ZISP" S CODE(1,0)="$$GETDTIO^CASHR("_FILE_","_FIELD_",..%Id())" "RTN","CASH3",201,0) D ADDCODE^CASHFN11(FILE,FIELD,.CODE) "RTN","CASH3",202,0) Q "RTN","CASH3",203,0) ; "RTN","CASH3",204,0) ; 7. Pointer "RTN","CASH3",205,0) ; Add Reference to Pointed to Class/Table "RTN","CASH3",206,0) ; "RTN","CASH3",207,0) PNTR(FILE,FIELD,LABEL,DESC,REQ,SQLLBL,DATALBL,NODE,PIECE,RCODE,SPEC,FLAGS) ; "RTN","CASH3",208,0) N PFILE "RTN","CASH3",209,0) S PFILE=+$P(SPEC,"P",2) "RTN","CASH3",210,0) Q:'PFILE "RTN","CASH3",211,0) ; Add Field "RTN","CASH3",212,0) D ADDFLD^CASHFN11(FILE,FIELD,LABEL,0,"","",DESC,"",0,REQ,"",0,"CASH.FileMan.Pointer","P",SQLLBL) "RTN","CASH3",213,0) ; Add Parameters "RTN","CASH3",214,0) D ADDPARAM^CASHFN11(FILE,FIELD,1,"PFILE",PFILE) "RTN","CASH3",215,0) D ADDPARAM^CASHFN11(FILE,FIELD,2,"PFIELD",".01") "RTN","CASH3",216,0) ; Add to Master Map Data "RTN","CASH3",217,0) D ADDDATA^CASHFN11(FILE,1,FIELD,DATALBL,NODE,PIECE,1,RCODE) "RTN","CASH3",218,0) Q "RTN","CASH3",219,0) ; "RTN","CASH3",220,0) ; 8. Variable Pointer "RTN","CASH3",221,0) ; "RTN","CASH3",222,0) VP(FILE,FIELD,LABEL,DESC,REQ,SQLLBL,DATALBL,NODE,PIECE,RCODE) ; "RTN","CASH3",223,0) N PTYPE "RTN","CASH3",224,0) S PTYPE="CASH.FileMan.VariablePointer" "RTN","CASH3",225,0) ; Add Field "RTN","CASH3",226,0) D ADDFLD^CASHFN11(FILE,FIELD,LABEL,0,"","",DESC,"",0,REQ,"",0,PTYPE,"D",SQLLBL) "RTN","CASH3",227,0) ; Add Parameters "RTN","CASH3",228,0) D ADDPARAM^CASHFN11(FILE,FIELD,1,"FILE",FILE) "RTN","CASH3",229,0) D ADDPARAM^CASHFN11(FILE,FIELD,2,"FIELD",FIELD) "RTN","CASH3",230,0) ; Add to Master Map Data "RTN","CASH3",231,0) D ADDDATA^CASHFN11(FILE,1,FIELD,DATALBL,NODE,PIECE,0,RCODE) "RTN","CASH3",232,0) Q "RTN","CASH3",233,0) ; "RTN","CASH3",234,0) ; "RTN","CASH3",235,0) ; 9. MUMPS "RTN","CASH3",236,0) ; "RTN","CASH3",237,0) MUMPS(FILE,FIELD,LABEL,DESC,REQ,SQLLBL,DATALBL,RCODE,EXT2,INDEXED) ; "RTN","CASH3",238,0) N PTYPE "RTN","CASH3",239,0) S PTYPE="%Library.String" "RTN","CASH3",240,0) ; Add Field "RTN","CASH3",241,0) D ADDFLD^CASHFN11(FILE,FIELD,LABEL,0,"","",DESC,"",0,REQ,"",0,PTYPE,"D",SQLLBL) "RTN","CASH3",242,0) ; Add Parameters "RTN","CASH3",243,0) D ADDPARAM^CASHFN11(FILE,FIELD,1,"MAXLEN",EXT2) "RTN","CASH3",244,0) D ADDPARAM^CASHFN11(FILE,FIELD,2,"MINLEN",1) "RTN","CASH3",245,0) I INDEXED D ADDPARAM^CASHFN11(FILE,FIELD,3,"COLLATION","EXACT") "RTN","CASH3",246,0) ; Add to Master Map Data "RTN","CASH3",247,0) D ADDDATA^CASHFN11(FILE,1,FIELD,DATALBL,"","",0,RCODE) "RTN","CASH3",248,0) Q "RTN","CASHC") 0^6^B62590378 "RTN","CASHC",1,0) CASHC ;ALB/MGC - Compiler for Cache version 5.0.x+ ; 10/20/04@3:00:00 "RTN","CASHC",2,0) ;;1.0;FM TO CACHE SQL;;Jul 08, 2005 "RTN","CASHC",3,0) ; "RTN","CASHC",4,0) Q ; Specific Entry Point must be used "RTN","CASHC",5,0) ; "RTN","CASHC",6,0) CREATE(FILE,FLAGS,PACKAGE,ID,OWNER,LIST,TMPLIST) ; Create and Compile (Cache 5+) "RTN","CASHC",7,0) ; "RTN","CASHC",8,0) ; IMPORTANT: Do Not call directly! "RTN","CASHC",9,0) ; This entry point should only be accessed by CREATE^CASH or ALL^CASHC "RTN","CASHC",10,0) ; "RTN","CASHC",11,0) ; See CREATE^CASH for documentation. "RTN","CASHC",12,0) ; "RTN","CASHC",13,0) N X S X="ERROR^CASHCU" S @^%ZOSF("TRAP") "RTN","CASHC",14,0) N CLNAME,ERROR,EXISTS,MAXM,MAXT,NAME,NODE0,OK,PLIST,ROWID,SQLNM,UIDNM "RTN","CASHC",15,0) N %ROWCOUNT,%objcn,%objlasterror "RTN","CASHC",16,0) ; "RTN","CASHC",17,0) ; Check File has been Discovered by CASH "RTN","CASHC",18,0) I $G(FILE)="" W:$G(FLAGS)["V" !,"File# must be passed in",! Q 0 "RTN","CASHC",19,0) I '$D(^CASH(15050.11,FILE)) W:$G(FLAGS)["V" !,"File#: ",FILE," has not been discovered (use START^CASH)",! Q 0 "RTN","CASHC",20,0) ; "RTN","CASHC",21,0) ; Quit if this file has already been Compiled for this session "RTN","CASHC",22,0) I $D(^TMP("CASHC",$J,FILE)) Q 1 "RTN","CASHC",23,0) S ^TMP("CASHC",$J,FILE)="" "RTN","CASHC",24,0) ; "RTN","CASHC",25,0) ; Initilize optional Parameters "RTN","CASHC",26,0) S FLAGS=$G(FLAGS) "RTN","CASHC",27,0) S PACKAGE=$G(PACKAGE) "RTN","CASHC",28,0) I PACKAGE="" S PACKAGE="User" ;Default to User package if none passed "RTN","CASHC",29,0) S ID=$G(ID) "RTN","CASHC",30,0) S OWNER=$G(OWNER) "RTN","CASHC",31,0) I $D(LIST),'($D(LIST)\10) K LIST "RTN","CASHC",32,0) I $D(TMPLIST),'($D(TMPLIST)\10) K TMPLIST "RTN","CASHC",33,0) ; "RTN","CASHC",34,0) ; Unpack Names from File #15050.11, using passed in FLAGS, PACKAGE and ID "RTN","CASHC",35,0) D GETNAMES^CASHCN(FILE,FLAGS,PACKAGE,ID,.NAME,.SQLNM,.UIDNM,.ROWID) "RTN","CASHC",36,0) S CLNAME=PACKAGE_"."_NAME "RTN","CASHC",37,0) ; "RTN","CASHC",38,0) ; Check if Class exists and Delete if necessary (FORCE=1) "RTN","CASHC",39,0) S EXISTS=##CLASS(%Dictionary.ClassDefinition).%ExistsId(CLNAME) "RTN","CASHC",40,0) I EXISTS,FLAGS'["F" W:FLAGS["V" !,CLNAME," already exists (use ""F"" to overwrite)",! Q 1 "RTN","CASHC",41,0) ; "RTN","CASHC",42,0) ; Attempt to Lock the class "RTN","CASHC",43,0) L +^oddDEF(CLNAME):1 "RTN","CASHC",44,0) I '$T W:FLAGS["V" !,CLNAME," is locked",! Q 0 "RTN","CASHC",45,0) ; "RTN","CASHC",46,0) ; Delete current version of class if it exists "RTN","CASHC",47,0) I EXISTS D CLDEL^CASHCU(CLNAME) "RTN","CASHC",48,0) ; "RTN","CASHC",49,0) ; Check required field mapped if LIST array is passed in! "RTN","CASHC",50,0) I $D(LIST) D "RTN","CASHC",51,0) .; The .01 field is always mapped "RTN","CASHC",52,0) .I '$D(LIST(FILE,.01)) S LIST(FILE,.01)="" "RTN","CASHC",53,0) .; Make sure Relationship field (#15050.111) is mapped for Multiple sub-files! "RTN","CASHC",54,0) .I '$$ISFILE^CASHU(FILE),'$D(LIST(FILE,15050.111)) S LIST(FILE,15050.111)="" "RTN","CASHC",55,0) .Q "RTN","CASHC",56,0) ; "RTN","CASHC",57,0) ; Large File Fixes (see TMPLIST^CASHC0 for more information) "RTN","CASHC",58,0) ; Create a TMPLIST array, that isn't passed to sub-files "RTN","CASHC",59,0) ; Initialize Maximum values "RTN","CASHC",60,0) D MAXVALS^CASHCU(FILE,FLAGS,.MAXT,.MAXM) "RTN","CASHC",61,0) ; Large Number of Properties fix (>250 by default) "RTN","CASHC",62,0) I '$D(LIST),'$D(TMPLIST),$$FLDCNT^CASHFN11(FILE)>MAXT D TMPLIST^CASHC0(FILE,FLAGS,MAXT,MAXM,.TMPLIST) "RTN","CASHC",63,0) ; Large number of Multiples fix (>75 by default) "RTN","CASHC",64,0) I '$D(LIST),'$D(TMPLIST),$P($G(^CASH(15050.11,FILE,4,0)),"^",4)>MAXM D "RTN","CASHC",65,0) .N FIELD,FLDCAT,SUBS "RTN","CASHC",66,0) .S (FIELD,SUBS)=0 "RTN","CASHC",67,0) .K ^TMP("CASHC",$J,"LIST",FILE) "RTN","CASHC",68,0) .F S FIELD=$O(^CASH(15050.11,FILE,1,FIELD)) Q:'+FIELD D "RTN","CASHC",69,0) ..S FLDCAT=$P($G(^CASH(15050.11,FILE,1,FIELD,3)),"^",1) "RTN","CASHC",70,0) ..; Count Multiples and add excess to ^TMP("CASHC",$J,"LIST") for continuation classes "RTN","CASHC",71,0) ..I FLDCAT="M" S SUBS=SUBS+1 I SUBS>MAXM S ^TMP("CASHC",$J,"LIST",FILE,(SUBS-1\MAXM),FIELD)="" Q "RTN","CASHC",72,0) ..; Try to ensure that WP Field ends up in the same Class as its Multiple "RTN","CASHC",73,0) ..I FLDCAT="W",SUBS' errors. Many sites have Low "Maximum Memory Per Process" settings! "RTN","CASHC",89,0) ; "RTN","CASHC",90,0) ; Create any Required Sub-Classes if FLAGS["M" "RTN","CASHC",91,0) I FLAGS["M" D I 'OK Q 0 "RTN","CASHC",92,0) .N CFLAGS,FIELD "RTN","CASHC",93,0) .S CFLAGS=FLAGS,OK=1 "RTN","CASHC",94,0) .; If R not passed, strip P from CFLAGS "RTN","CASHC",95,0) .I FLAGS'["R",FLAGS'["r" S CFLAGS=$TR(CFLAGS,"P","") "RTN","CASHC",96,0) .S FIELD="" "RTN","CASHC",97,0) .F S FIELD=$O(^CASH(15050.11,FILE,1,"C","M",FIELD)) Q:FIELD="" D Q:'OK "RTN","CASHC",98,0) ..; If LIST array passed in check if Field should be mapped "RTN","CASHC",99,0) ..; Also check for WP multiple which has 0.0000001 added "RTN","CASHC",100,0) ..I $D(LIST),'$D(LIST(FILE,FIELD)),'$D(LIST(FILE,FIELD-0.0000001)) Q "RTN","CASHC",101,0) ..; If TMPLIST array created check if Field should be mapped "RTN","CASHC",102,0) ..I $D(TMPLIST),'$D(TMPLIST(FIELD)) Q "RTN","CASHC",103,0) ..N PNODE0,SUBFILE,TYPE "RTN","CASHC",104,0) ..S PNODE0=^CASH(15050.11,FILE,1,FIELD,0) "RTN","CASHC",105,0) ..S TYPE=$P(PNODE0,"^",9) "RTN","CASHC",106,0) ..S SUBFILE=+$TR(TYPE,"#","") "RTN","CASHC",107,0) ..I $D(^TMP("CASHC",$J,SUBFILE)) Q "RTN","CASHC",108,0) ..S OK=$$CREATE(SUBFILE,CFLAGS,PACKAGE,ID,OWNER,.LIST) "RTN","CASHC",109,0) ..I OK,FLAGS["S" S ^TMP("CASHCW",$J,"SUB",FILE,SUBFILE)="" "RTN","CASHC",110,0) ..Q "RTN","CASHC",111,0) .Q "RTN","CASHC",112,0) ; "RTN","CASHC",113,0) ; Create Classes for Pointed to FILES "RTN","CASHC",114,0) I FLAGS["P" D I 'OK Q 0 "RTN","CASHC",115,0) .N PFLAGS,FIELD "RTN","CASHC",116,0) .S PFLAGS=FLAGS,OK=1 "RTN","CASHC",117,0) .; If R not passed, strip M & P from PFLAGS "RTN","CASHC",118,0) .I FLAGS'["R" S PFLAGS=$TR(PFLAGS,"MP","") "RTN","CASHC",119,0) .S FIELD="" "RTN","CASHC",120,0) .F S FIELD=$O(^CASH(15050.11,FILE,1,"C","P",FIELD)) Q:FIELD="" D Q:'OK "RTN","CASHC",121,0) ..; If LIST array passed in check if Field should be mapped "RTN","CASHC",122,0) ..I $D(LIST),'$D(LIST(FILE,FIELD)) Q "RTN","CASHC",123,0) ..; If TMPLIST array created check if Field should be mapped "RTN","CASHC",124,0) ..I $D(TMPLIST),'$D(TMPLIST(FIELD)) Q "RTN","CASHC",125,0) ..N PFILE "RTN","CASHC",126,0) ..S PFILE=$P($G(^CASH(15050.11,FILE,1,FIELD,1,1,0)),"^",2) "RTN","CASHC",127,0) ..I FILE=PFILE Q "RTN","CASHC",128,0) ..I $D(^TMP("CASHC",$J,PFILE)) Q "RTN","CASHC",129,0) ..N FIELD "RTN","CASHC",130,0) ..S OK=$$CREATE(PFILE,PFLAGS,PACKAGE,ID,OWNER,.LIST) "RTN","CASHC",131,0) ..Q "RTN","CASHC",132,0) .Q "RTN","CASHC",133,0) ; "RTN","CASHC",134,0) ; Loop through and add Properties "RTN","CASHC",135,0) I '$$PROPS^CASHC1(FILE,FLAGS,PACKAGE,CLNAME,UIDNM,ROWID,.LIST,.TMPLIST,.PLIST) Q 0 "RTN","CASHC",136,0) ; "RTN","CASHC",137,0) ; Loop through and add any Methods "RTN","CASHC",138,0) I '$$METHODS^CASHC2(FILE,FLAGS,PACKAGE,CLNAME,.LIST,.TMPLIST) Q 0 "RTN","CASHC",139,0) ; "RTN","CASHC",140,0) ; Add Triggers "RTN","CASHC",141,0) I '$$TRIGGERS^CASHC3(FILE,FLAGS,CLNAME,UIDNM,.LIST,.TMPLIST) Q 0 "RTN","CASHC",142,0) ; "RTN","CASHC",143,0) ; Create the Storage "RTN","CASHC",144,0) I '$$STORAGE^CASHC4(FILE,FLAGS,PACKAGE,ID,CLNAME,UIDNM,.LIST,.TMPLIST) Q 0 "RTN","CASHC",145,0) K TMPLIST "RTN","CASHC",146,0) ; "RTN","CASHC",147,0) ; Compile the Class "RTN","CASHC",148,0) ; (Sub-files must be compiled with their master class) "RTN","CASHC",149,0) I $$ISFILE^CASHU(FILE) D CLCOMP^CASHCU(CLNAME,OWNER,FLAGS) "RTN","CASHC",150,0) ; "RTN","CASHC",151,0) ; Create Continuation Classes if ^TMP("CASHC",$J,"LIST") is defined "RTN","CASHC",152,0) I $D(^TMP("CASHC",$J,"LIST",FILE)),'$D(^TMP("CASHC",$J,"NAME-EXT",FILE)) D I 'OK Q 0 "RTN","CASHC",153,0) .N I "RTN","CASHC",154,0) .F I=1:1:26 Q:'$D(^TMP("CASHC",$J,"LIST",FILE,I)) D Q:'OK "RTN","CASHC",155,0) ..N LIST,TMPLIST "RTN","CASHC",156,0) ..M TMPLIST=^TMP("CASHC",$J,"LIST",FILE,I) "RTN","CASHC",157,0) ..S ^TMP("CASHC",$J,"NAME-EXT",FILE)=$C(64+I) "RTN","CASHC",158,0) ..K ^TMP("CASHC",$J,FILE) ; Remove completed flag for this file "RTN","CASHC",159,0) ..S OK=$$CREATE(FILE,FLAGS,PACKAGE,ID,OWNER,.LIST,.TMPLIST) "RTN","CASHC",160,0) ..I OK,'$$ISFILE^CASHU(FILE) S OK=$$REL^CASHC1(FILE,FLAGS,PACKAGE,ID) "RTN","CASHC",161,0) ..Q "RTN","CASHC",162,0) .K ^TMP("CASHC",$J,"LIST",FILE) "RTN","CASHC",163,0) .K ^TMP("CASHC",$J,"NAME-EXT",FILE) "RTN","CASHC",164,0) .Q "RTN","CASHC",165,0) ; "RTN","CASHC",166,0) ; Create SOAP Web Service Class if "S" passed in "RTN","CASHC",167,0) I FLAGS["S",'$$WEBSVC^CASHC5(FILE,FLAGS,PACKAGE,OWNER,NAME,PLIST) Q 0 "RTN","CASHC",168,0) ; "RTN","CASHC",169,0) Q 1 "RTN","CASHC",170,0) ; "RTN","CASHC",171,0) ALL(FLAGS,PACKAGE,ID,OWNER) ;Compile all FileMan Files "RTN","CASHC",172,0) ; "RTN","CASHC",173,0) ; IMPORTANT: Do Not call directly! "RTN","CASHC",174,0) ; This entry point should only be accessed by ALL^CASH "RTN","CASHC",175,0) ; "RTN","CASHC",176,0) N CNT,CNTOK,DEL,FILE,I,TIME,TOT "RTN","CASHC",177,0) ; "RTN","CASHC",178,0) ; Lock ^XTMP("CASH") "RTN","CASHC",179,0) I '$$LOCK^CASHU($J,"ALL^CASH") Q "RTN","CASHC",180,0) ; Initialize Temporary Globals "RTN","CASHC",181,0) K ^TMP("CASH",$J),^TMP("CASHC",$J) "RTN","CASHC",182,0) S TIME(1)=$H "RTN","CASHC",183,0) ; "RTN","CASHC",184,0) ; Discover all files "RTN","CASHC",185,0) ; Ensure ^DIC(FILE,0) node is defined, and that FILE is not defined as a Sub-file "RTN","CASHC",186,0) S FILE=0,TOT=$P($G(^DIC(0)),"^",4) "RTN","CASHC",187,0) F I=1:1 S FILE=$O(^DIC(FILE)) Q:'+FILE D "RTN","CASHC",188,0) .I $$ISFILE^CASHU(FILE) D DISCVR^CASH0(FILE,"MPRV") "RTN","CASHC",189,0) .I TOT S ^XTMP("CASH","STATUS")="Discovery (1/4) - "_$FN(I/TOT*100,"",2)_"%" "RTN","CASHC",190,0) .Q "RTN","CASHC",191,0) S TIME(2)=$H "RTN","CASHC",192,0) ; "RTN","CASHC",193,0) ; Delete any Classes that already exist for this Package "RTN","CASHC",194,0) S FILE=0,DEL=0,TOT=$P($G(^CASH(15050.11,0)),"^",4) "RTN","CASHC",195,0) F I=1:1 S FILE=$O(^CASH(15050.11,FILE)) Q:'+FILE D "RTN","CASHC",196,0) .N CLNAME,EXISTS "RTN","CASHC",197,0) .S CLNAME=$$GETCLNM^CASHCN(FILE,FLAGS,PACKAGE) "RTN","CASHC",198,0) .S EXISTS=##CLASS(%Dictionary.ClassDefinition).%ExistsId(CLNAME) "RTN","CASHC",199,0) .I EXISTS D CLDEL^CASHCU(CLNAME) S DEL=DEL+1 "RTN","CASHC",200,0) .I TOT S ^XTMP("CASH","STATUS")="Clean Up (2/4) - "_$FN(I/TOT*100,"",2)_"%" "RTN","CASHC",201,0) .Q "RTN","CASHC",202,0) S TIME(3)=$H "RTN","CASHC",203,0) ; "RTN","CASHC",204,0) ; Compile Classes "RTN","CASHC",205,0) ; Note: This is done in numeric order, except where classes have dependancies "RTN","CASHC",206,0) S FILE=0 "RTN","CASHC",207,0) F I=1:1 S FILE=$O(^CASH(15050.11,FILE)) Q:'+FILE I $$ISFILE^CASHU(FILE) D "RTN","CASHC",208,0) .N CLNAME,COMP,DEL,OK,TIME "RTN","CASHC",209,0) .S CLNAME=$$GETCLNM^CASHCN(FILE,FLAGS,PACKAGE) "RTN","CASHC",210,0) .W !,FILE "RTN","CASHC",211,0) .S COMP=##CLASS(%Dictionary.CompiledClass).%ExistsId($LB(CLNAME)) "RTN","CASHC",212,0) .I COMP W !,"1^Already Compiled" Q "RTN","CASHC",213,0) .S OK=$$CREATE(FILE,"EFMPRV"_FLAGS,PACKAGE,ID,OWNER) "RTN","CASHC",214,0) .W !,$S(OK:OK,1:OK_"^Failed") "RTN","CASHC",215,0) .I TOT S ^XTMP("CASH","STATUS")="Compile (3/4) - "_$FN(I/TOT*100,"",2)_"%" "RTN","CASHC",216,0) .Q "RTN","CASHC",217,0) S TIME(4)=$H "RTN","CASHC",218,0) ; "RTN","CASHC",219,0) ; Count the number of successfully compiled Classes "RTN","CASHC",220,0) S (CNT,CNTOK,FILE)=0 "RTN","CASHC",221,0) F I=1:1 S FILE=$O(^CASH(15050.11,FILE)) Q:'+FILE D "RTN","CASHC",222,0) .N CLNAME "RTN","CASHC",223,0) .S CLNAME=$$GETCLNM^CASHCN(FILE,FLAGS,PACKAGE) "RTN","CASHC",224,0) .S CNT=CNT+1 "RTN","CASHC",225,0) .I $$CLASSOK^CASHCU(CLNAME) S CNTOK=CNTOK+1 "RTN","CASHC",226,0) .I TOT S ^XTMP("CASH","STATUS")="Checking (4/4) - "_$FN(I/TOT*100,"",2)_"%" "RTN","CASHC",227,0) .Q "RTN","CASHC",228,0) W !!,"Total Classes Discovered: ",CNT," in ",$$TPLEN^CASHCU(TIME(1),TIME(2)) "RTN","CASHC",229,0) W !,"Total Old Classes Removed: ",DEL," in ",$$TPLEN^CASHCU(TIME(2),TIME(3)) "RTN","CASHC",230,0) W !,"Total New Classes Compiled: ",CNTOK," (",$FN(CNTOK/CNT*100,"",2),"%)"," in ",$$TPLEN^CASHCU(TIME(3),TIME(4)) "RTN","CASHC",231,0) ; "RTN","CASHC",232,0) ; Delete Temporary Globals and unlock ^XTMP("CASH") "RTN","CASHC",233,0) K ^TMP("CASH",$J),^TMP("CASHC",$J) "RTN","CASHC",234,0) D UNLOCK^CASHU($J) "RTN","CASHC",235,0) ; "RTN","CASHC",236,0) Q "RTN","CASHC0") 0^7^B29275632 "RTN","CASHC0",1,0) CASHC0 ;ALB/MGC - Compiler for Cache version 5.0.x+ - Continued (Classes); 10/20/04@3:00:00 "RTN","CASHC0",2,0) ;;1.0;FM TO CACHE SQL;;Jul 08, 2005 "RTN","CASHC0",3,0) ; "RTN","CASHC0",4,0) ; IMPORTANT: These calls are for INTERNAL use only "RTN","CASHC0",5,0) ; "RTN","CASHC0",6,0) CLASS(FILE,FLAGS,OWNER,CLNAME,SQLNM,UIDNM,ROWID) ; Create the new Class "RTN","CASHC0",7,0) N CLASS,DESC,INDEX,OK,PARAM,SUPER,UID "RTN","CASHC0",8,0) S CLASS=##CLASS(%Dictionary.ClassDefinition).%New() "RTN","CASHC0",9,0) S CLASS.Name=CLNAME "RTN","CASHC0",10,0) S SUPER="%Persistent" "RTN","CASHC0",11,0) I FLAGS["X" S SUPER=SUPER_",%XML.Adaptor" I FLAGS["W" S SUPER=SUPER_",%CSP.Page" "RTN","CASHC0",12,0) S CLASS.Super=SUPER "RTN","CASHC0",13,0) S CLASS.ClassType="persistent" "RTN","CASHC0",14,0) S CLASS.ProcedureBlock=1 "RTN","CASHC0",15,0) I $D(^DD(FILE)) S DESC="DO NOT EDIT: FileMan File #: "_FILE_" Name: "_$P($G(^DIC(FILE,0)),"^",1)_" - mapped by CASH" "RTN","CASHC0",16,0) E S DESC="DO NOT EDIT: FileMan Utility Class: "_CLNAME_" - mapped by CASH" "RTN","CASHC0",17,0) S CLASS.Description=DESC "RTN","CASHC0",18,0) I ROWID'="" S CLASS.SqlRowIdName=ROWID "RTN","CASHC0",19,0) S CLASS.SqlRowIdPrivate=$S(ROWID'="":0,FLAGS["H":0,1:1) "RTN","CASHC0",20,0) I SQLNM'="" S CLASS.SqlTableName=SQLNM "RTN","CASHC0",21,0) I $G(OWNER)'="" S CLASS.Owner=OWNER "RTN","CASHC0",22,0) ; "RTN","CASHC0",23,0) ; Add the READONLY parameter "RTN","CASHC0",24,0) S PARAM=##CLASS(%Dictionary.ParameterDefinition).%New() "RTN","CASHC0",25,0) S PARAM.Name="READONLY" "RTN","CASHC0",26,0) S PARAM.Default=$S(FLAGS["U":0,1:1) "RTN","CASHC0",27,0) I $D(^DD(FILE)) S DESC="Updates should NOT be allowed through default SQL!" "RTN","CASHC0",28,0) E S DESC="Updates CANNOT be made via SQL!" "RTN","CASHC0",29,0) S PARAM.Description=DESC "RTN","CASHC0",30,0) D CLASS.Parameters.SetAt(PARAM,1) "RTN","CASHC0",31,0) D CLASS.Parameters.%UnSwizzleAt(1) "RTN","CASHC0",32,0) K PARAM "RTN","CASHC0",33,0) ; "RTN","CASHC0",34,0) ; Add the Unique Identity Property "RTN","CASHC0",35,0) S UID=##CLASS(%Dictionary.PropertyDefinition).%New() "RTN","CASHC0",36,0) S UID.Name=UIDNM "RTN","CASHC0",37,0) S UID.Type="%Library.Float" "RTN","CASHC0",38,0) S UID.Description="Unique Object Identity/Primary Key - equivalent to IEN" "RTN","CASHC0",39,0) S UID.Required=1 "RTN","CASHC0",40,0) S UID.SqlColumnNumber=2 "RTN","CASHC0",41,0) D CLASS.Properties.SetAt(UID,1) "RTN","CASHC0",42,0) D CLASS.Properties.%UnSwizzleAt(1) "RTN","CASHC0",43,0) K UID "RTN","CASHC0",44,0) ; "RTN","CASHC0",45,0) ; Add the Unique Identity Property Index "RTN","CASHC0",46,0) S INDEX=##CLASS(%Dictionary.IndexDefinition).%New() "RTN","CASHC0",47,0) S INDEX.Name=UIDNM_$S($L(UIDNM)>28:"",$L(UIDNM)>26:"Inx",1:"Index") "RTN","CASHC0",48,0) S INDEX.Description="Unique Identity Index on "_UIDNM "RTN","CASHC0",49,0) S INDEX.IdKey=1 "RTN","CASHC0",50,0) S INDEX.PrimaryKey=1 "RTN","CASHC0",51,0) S INDEX.Unique=1 "RTN","CASHC0",52,0) S INDEX.Properties=UIDNM "RTN","CASHC0",53,0) D CLASS.Indices.SetAt(INDEX,1) "RTN","CASHC0",54,0) D CLASS.Indices.%UnSwizzleAt(1) "RTN","CASHC0",55,0) K INDEX "RTN","CASHC0",56,0) ; "RTN","CASHC0",57,0) ; Save Class definition so far "RTN","CASHC0",58,0) S OK=CLASS.%Save() "RTN","CASHC0",59,0) I 'OK D ERRSAV^CASHCU("Class: "_CLASS.Name,$G(FILE),$G(FLAGS),$G(PACKAGE),$G(ID),$G(OWNER),"",$G(%objlasterror),.LIST) "RTN","CASHC0",60,0) Q OK "RTN","CASHC0",61,0) ; "RTN","CASHC0",62,0) TMPLIST(FILE,FLAGS,MAXT,MAXM,TMPLIST) ; Create TMPLIST for very large files. "RTN","CASHC0",63,0) ; Cache SQL has a limitation that doesn't allow it to map very large files! "RTN","CASHC0",64,0) ; The Class Descriptor seems to be of type %String and therefor limited to 32K. "RTN","CASHC0",65,0) ; When too many Properties are added this figure is exceeded and the compile fails. "RTN","CASHC0",66,0) ; This section of code attempts to prioritise and limit the number of fields mapped "RTN","CASHC0",67,0) ; to 240. There's no guarantee that 240 will always work, and it's very likely that "RTN","CASHC0",68,0) ; more would be fine, but I had to pick a number! "RTN","CASHC0",69,0) ; Fields are prioritised as follows: Relationships, Indexed Fields, Pointers, "RTN","CASHC0",70,0) ; then all others. "RTN","CASHC0",71,0) ; You can use the LIST array to create your own subset classes. "RTN","CASHC0",72,0) N CAT,FIELD,FLD,MAP,SUBS,TOT "RTN","CASHC0",73,0) K TMPLIST "RTN","CASHC0",74,0) K ^TMP("CASHC",$J,"LIST",FILE) "RTN","CASHC0",75,0) ; Add the .01 field and special 15050.111 field (this is vital for sub-files) "RTN","CASHC0",76,0) S TMPLIST(.01)="",TMPLIST=1 "RTN","CASHC0",77,0) I '$$ISFILE^CASHU(FILE) S TMPLIST(15050.111)="",TMPLIST=TMPLIST+1 "RTN","CASHC0",78,0) ; Add Relationships (these are required if the M flag is passed) "RTN","CASHC0",79,0) S FIELD="",SUBS=0 "RTN","CASHC0",80,0) I FLAGS["M" F S FIELD=$O(^CASH(15050.11,FILE,1,"C","M",FIELD)) Q:FIELD="" D "RTN","CASHC0",81,0) .Q:$D(TMPLIST(FIELD)) "RTN","CASHC0",82,0) .; Keep a count of the number of Sub-files "RTN","CASHC0",83,0) .S SUBS=SUBS+1 "RTN","CASHC0",84,0) .; Check if this Multiple has a matching WP Field "RTN","CASHC0",85,0) .N FIELDW,WP "RTN","CASHC0",86,0) .S FIELDW=FIELD-.0000001,WP=0 "RTN","CASHC0",87,0) .I $D(^CASH(15050.11,FILE,1,"C","W",FIELDW)) S WP=1 "RTN","CASHC0",88,0) .; If 75 Sub-files have already been added, add subsequent fields to a continuation Class "RTN","CASHC0",89,0) .I SUBS>MAXM D Q "RTN","CASHC0",90,0) ..N CONT "RTN","CASHC0",91,0) ..S CONT=SUBS-1\MAXM "RTN","CASHC0",92,0) ..S ^TMP("CASHC",$J,"LIST",FILE,CONT,FIELD)="" "RTN","CASHC0",93,0) ..S TOT(CONT)=$G(TOT(CONT))+1 "RTN","CASHC0",94,0) ..; If matching WP Field exists, add it to the same continuation Class "RTN","CASHC0",95,0) ..I WP S ^TMP("CASHC",$J,"LIST",FILE,CONT,FIELDW)="",TOT(CONT)=$G(TOT(CONT))+1 "RTN","CASHC0",96,0) ..Q "RTN","CASHC0",97,0) .; Add Field to the TMPLIST array "RTN","CASHC0",98,0) .S TMPLIST(FIELD)="" "RTN","CASHC0",99,0) .S TMPLIST=$G(TMPLIST)+1 "RTN","CASHC0",100,0) .; If matching WP Field exists, add it to the TMPLIST array "RTN","CASHC0",101,0) .I WP S TMPLIST(FIELDW)="",TMPLIST=$G(TMPLIST)+1 "RTN","CASHC0",102,0) .Q "RTN","CASHC0",103,0) ; Add Indexed Fields (Check Map Data sub-field #15050.1131) "RTN","CASHC0",104,0) S FIELD="" "RTN","CASHC0",105,0) F S FIELD=$O(^CASH(15050.11,FILE,3,"F",FIELD)) Q:FIELD="" D "RTN","CASHC0",106,0) .Q:$D(TMPLIST(FIELD)) "RTN","CASHC0",107,0) .I TMPLIST'",$G(%objlasterror),.LIST) Q OK "RTN","CASHC1",26,0) K PROP(I) "RTN","CASHC1",27,0) ; "RTN","CASHC1",28,0) S FIELD=0,I=I+1 "RTN","CASHC1",29,0) I FLAGS["S" S PLIST="%ID,"_UIDNM "RTN","CASHC1",30,0) F S FIELD=$O(^CASH(15050.11,FILE,1,FIELD)) Q:'+FIELD D Q:'OK "RTN","CASHC1",31,0) .N ALTLBL,ALTSQL,CARD,CAT,COLL,DESC,INV,LABEL,PNODE0,PNODE3,REL,REQ,SQLCODE,SQLNM,TYPE "RTN","CASHC1",32,0) .; If LIST array passed in check if Field should be mapped "RTN","CASHC1",33,0) ..; Also check for WP multiple which has 0.0000001 added "RTN","CASHC1",34,0) .I $D(LIST),'$D(LIST(FILE,FIELD)),'$D(LIST(FILE,FIELD-0.0000001)) Q "RTN","CASHC1",35,0) .; If TMPLIST array created check if Field should be mapped "RTN","CASHC1",36,0) .I $D(TMPLIST),'$D(TMPLIST(FIELD)) Q "RTN","CASHC1",37,0) .; Get the 0 node "RTN","CASHC1",38,0) .S PNODE0=^CASH(15050.11,FILE,1,FIELD,0) "RTN","CASHC1",39,0) .S LABEL=$P(PNODE0,"^",1) "RTN","CASHC1",40,0) .S CARD=$P(PNODE0,"^",3) I CARD'="" S CARD=$$SOCOUT^CASHR0(15050.111,.03,CARD) "RTN","CASHC1",41,0) .S COLL=$P(PNODE0,"^",4) I COLL'="" S COLL=$$SOCOUT^CASHR0(15050.111,.04,COLL) "RTN","CASHC1",42,0) .S INV=$P(PNODE0,"^",5) "RTN","CASHC1",43,0) .S REL=$P(PNODE0,"^",6) "RTN","CASHC1",44,0) .S REQ=$P(PNODE0,"^",7) "RTN","CASHC1",45,0) .S TYPE=$P(PNODE0,"^",9) "RTN","CASHC1",46,0) .S DESC=$G(^CASH(15050.11,FILE,1,FIELD,1)) "RTN","CASHC1",47,0) .S SQLCODE=$G(^CASH(15050.11,FILE,1,FIELD,2)) "RTN","CASHC1",48,0) .S PNODE3=$G(^CASH(15050.11,FILE,1,FIELD,3)) "RTN","CASHC1",49,0) .S CAT=$P(PNODE3,"^",1) "RTN","CASHC1",50,0) .S SQLNM=$P(PNODE3,"^",2) "RTN","CASHC1",51,0) .; Alternate Labels for Pointers "RTN","CASHC1",52,0) .S ALTLBL=LABEL_"ID",ALTSQL="" "RTN","CASHC1",53,0) .; "RTN","CASHC1",54,0) .; If Multiple, quit if M not passed in FLAGS "RTN","CASHC1",55,0) .I CAT="M",FLAGS'["M" Q "RTN","CASHC1",56,0) .; If Pointer, quit if P or E not passed in FLAGS, otherwise Get alternate labels "RTN","CASHC1",57,0) .I CAT="P",FLAGS'["P"&(FLAGS'["E") Q "RTN","CASHC1",58,0) .; "RTN","CASHC1",59,0) .; If SqlRowIdName has been overriden (Sub-Files), "ID" must be changed to ROWID "RTN","CASHC1",60,0) .I SQLCODE["{ID}",ROWID'="" S SQLCODE=$P(SQLCODE,"{ID}",1)_"{"_ROWID_"}"_$P(SQLCODE,"{ID}",2) "RTN","CASHC1",61,0) .; If Loose Validation ("L" flag), relax the Required and Date constraints "RTN","CASHC1",62,0) .I FLAGS["L" S REQ=0 I TYPE["CASH.FileMan.Date" S TYPE="CASH.FileMan.StringDateTime" "RTN","CASHC1",63,0) .; Check if Relationship and change names if FLAGS["N" "RTN","CASHC1",64,0) .I REL,FLAGS["N" D "RTN","CASHC1",65,0) ..N UIDNM,ROWID "RTN","CASHC1",66,0) ..I CARD="children" D GETNAMES^CASHCN(FILE,"N","","","","",.UIDNM,.ROWID) S INV=$S(ROWID'="":ROWID,1:UIDNM) Q "RTN","CASHC1",67,0) ..I CARD="parent" D GETNAMES^CASHCN($E(TYPE,2,255),"N","","","","",.UIDNM,.ROWID) S LABEL=$S(ROWID'="":ROWID,1:UIDNM) Q "RTN","CASHC1",68,0) ..Q "RTN","CASHC1",69,0) .; "RTN","CASHC1",70,0) .; HDR Compatibility - If FLAGS["H" change to HDR Datatypes (if installed) "RTN","CASHC1",71,0) .I FLAGS["H" D "RTN","CASHC1",72,0) ..I TYPE="CASH.FileMan.SetOfCodes",$D(^oddDEF("CASH.HDR.SetOfCodes")) S TYPE="CASH.HDR.SetOfCodes" Q "RTN","CASHC1",73,0) ..I TYPE="CASH.FileMan.StringDateTime"!(TYPE["CASH.FileMan.Date"),$D(^oddDEF("CASH.HDR.DateTime")) S TYPE="CASH.HDR.DateTime" Q "RTN","CASHC1",74,0) ..Q "RTN","CASHC1",75,0) .; "RTN","CASHC1",76,0) .; Check if TYPE points to a file #, if so get Class Name "RTN","CASHC1",77,0) .I TYPE?1"#".N.(1"."1.N) S TYPE=$$GETCLNM^CASHCN(TYPE,FLAGS,PACKAGE) "RTN","CASHC1",78,0) .; "RTN","CASHC1",79,0) .; If Pointer, create Reference if P passed in FLAGS, then quit if E not passed "RTN","CASHC1",80,0) .I CAT="P" D:FLAGS["P" Q:FLAGS'["E" Q:'OK "RTN","CASHC1",81,0) ..; Pointer Field "RTN","CASHC1",82,0) ..N PFILE,TYPE "RTN","CASHC1",83,0) ..S PFILE=$P($G(^CASH(15050.11,FILE,1,FIELD,1,1,0)),"^",2) "RTN","CASHC1",84,0) ..S TYPE=$$GETCLNM^CASHCN(PFILE,FLAGS,PACKAGE) "RTN","CASHC1",85,0) ..; Create new Property "RTN","CASHC1",86,0) ..S PROP(I)=##CLASS(%Dictionary.PropertyDefinition).%New() "RTN","CASHC1",87,0) ..S PROP(I).Name=ALTLBL "RTN","CASHC1",88,0) ..S PROP(I).Calculated=0 "RTN","CASHC1",89,0) ..S PROP(I).Cardinality="" "RTN","CASHC1",90,0) ..S PROP(I).Collection="" "RTN","CASHC1",91,0) ..S PROP(I).Description=DESC_$C(13,10)_"Pointer to File #: "_PFILE "RTN","CASHC1",92,0) ..S PROP(I).Inverse="" "RTN","CASHC1",93,0) ..S PROP(I).Relationship=0 "RTN","CASHC1",94,0) ..S PROP(I).Required=REQ "RTN","CASHC1",95,0) ..S PROP(I).SqlColumnNumber=I+1 "RTN","CASHC1",96,0) ..S PROP(I).SqlComputeCode="" "RTN","CASHC1",97,0) ..S PROP(I).SqlComputed=0 "RTN","CASHC1",98,0) ..S PROP(I).Type=TYPE "RTN","CASHC1",99,0) ..; Set SQL Field Name if appropriate "RTN","CASHC1",100,0) ..I ALTSQL'="" S PROP(I).SqlFieldName=ALTSQL "RTN","CASHC1",101,0) ..D CLASS.Properties.SetAt(PROP(I),I) "RTN","CASHC1",102,0) ..; Save Class definition so far "RTN","CASHC1",103,0) ..S OK=CLASS.%Save() "RTN","CASHC1",104,0) ..D CLASS.Properties.%UnSwizzleAt(I) "RTN","CASHC1",105,0) ..I 'OK D ERRSAV^CASHCU("Property: "_I_" - "_PROP(I).Name,$G(FILE),$G(FLAGS),$G(PACKAGE),$G(ID),$G(OWNER),"",$G(%objlasterror),.LIST) "RTN","CASHC1",106,0) ..I FLAGS["S" S PLIST=PLIST_","_LBL "RTN","CASHC1",107,0) ..K PROP(I) "RTN","CASHC1",108,0) ..S I=I+1 "RTN","CASHC1",109,0) ..Q "RTN","CASHC1",110,0) .; "RTN","CASHC1",111,0) .; Get Full Description from ^DD. There's no need to store this in #15050.11. "RTN","CASHC1",112,0) .I FLAGS["D",$D(^DD(FILE,FIELD,21)) D "RTN","CASHC1",113,0) ..F J=1:1 Q:'$D(^DD(FILE,FIELD,21,J)) S DESC=DESC_$C(13,10)_$G(^DD(FILE,FIELD,21,J,0)) "RTN","CASHC1",114,0) ..Q "RTN","CASHC1",115,0) .; Create new Property "RTN","CASHC1",116,0) .S PROP(I)=##CLASS(%Dictionary.PropertyDefinition).%New() "RTN","CASHC1",117,0) .S PROP(I).Name=LABEL "RTN","CASHC1",118,0) .S PROP(I).Calculated=$P(PNODE0,"^",2) "RTN","CASHC1",119,0) .S PROP(I).Cardinality=CARD "RTN","CASHC1",120,0) .S PROP(I).Collection=COLL "RTN","CASHC1",121,0) .S PROP(I).Description=DESC "RTN","CASHC1",122,0) .S PROP(I).Inverse=INV "RTN","CASHC1",123,0) .S PROP(I).Relationship=REL "RTN","CASHC1",124,0) .S PROP(I).Required=REQ "RTN","CASHC1",125,0) .S PROP(I).SqlComputed=$P(PNODE0,"^",8) "RTN","CASHC1",126,0) .S PROP(I).SqlComputeCode=SQLCODE "RTN","CASHC1",127,0) .S PROP(I).Type=TYPE "RTN","CASHC1",128,0) .; Add SQL Column Number (if Field is not a Relationship) "RTN","CASHC1",129,0) .I 'REL S PROP(I).SqlColumnNumber=I+1 "RTN","CASHC1",130,0) .; Set SQL Field Name if appropriate "RTN","CASHC1",131,0) .I SQLNM'="" S PROP(I).SqlFieldName=SQLNM "RTN","CASHC1",132,0) .; Loop through and add Parameters "RTN","CASHC1",133,0) .F J=1:1 Q:'$D(^CASH(15050.11,FILE,1,FIELD,1,J)) D "RTN","CASHC1",134,0) ..N PARAM,PARNODE0,VALUE "RTN","CASHC1",135,0) ..S PARNODE0=^CASH(15050.11,FILE,1,FIELD,1,J,0) "RTN","CASHC1",136,0) ..S PARAM=$P(PARNODE0,"^",1) "RTN","CASHC1",137,0) ..S VALUE=$P(PARNODE0,"^",2) "RTN","CASHC1",138,0) ..Q:PARAM="" "RTN","CASHC1",139,0) ..S OK=PROP(I).Parameters.SetAt(VALUE,PARAM) "RTN","CASHC1",140,0) ..Q "RTN","CASHC1",141,0) .; If FLAGS["O" set ODBCEXTENDED=1 for SetOfCode fields "RTN","CASHC1",142,0) .I FLAGS["O",TYPE="CASH.FileMan.SetOfCodes" S OK=PROP(I).Parameters.SetAt(1,"EXTENDEDODBC") "RTN","CASHC1",143,0) .D CLASS.Properties.SetAt(PROP(I),I) "RTN","CASHC1",144,0) .; Save Class definition so far "RTN","CASHC1",145,0) .S OK=CLASS.%Save() "RTN","CASHC1",146,0) .D CLASS.Properties.%UnSwizzleAt(I) "RTN","CASHC1",147,0) .I 'OK D ERRSAV^CASHCU("Property: "_I_" - "_PROP(I).Name,$G(FILE),$G(FLAGS),$G(PACKAGE),$G(ID),$G(OWNER),"",$G(%objlasterror),.LIST) "RTN","CASHC1",148,0) .I 'REL,FLAGS["S" S PLIST=PLIST_","_$S(SQLNM'="":SQLNM,1:LABEL) "RTN","CASHC1",149,0) .K PROP(I) "RTN","CASHC1",150,0) .S I=I+1 "RTN","CASHC1",151,0) .Q "RTN","CASHC1",152,0) Q OK "RTN","CASHC1",153,0) ; "RTN","CASHC1",154,0) REL(FILE,FLAGS,PACKAGE,ID) ; Add the Parent-Child Relationship for a continuation Sub-class "RTN","CASHC1",155,0) N CLASS,CLNAME,DESC,EXT,INV,LABEL,NAME,NO,PARENT,PNODE0,PROP,ROWID,SQLNM,TYPE,UIDNM "RTN","CASHC1",156,0) ; "RTN","CASHC1",157,0) ; Get the Class Name "RTN","CASHC1",158,0) S CLNAME=$$GETCLNM^CASHCN(FILE,FLAGS,PACKAGE) "RTN","CASHC1",159,0) I '$D(^oddDEF(CLNAME)) Q 0 "RTN","CASHC1",160,0) ; Get Extension Character "RTN","CASHC1",161,0) S EXT=$G(^TMP("CASHC",$J,"NAME-EXT",FILE)) "RTN","CASHC1",162,0) ; Unpack the data for Field #15050.111 "RTN","CASHC1",163,0) S PNODE0=$G(^CASH(15050.11,FILE,1,15050.111,0)) "RTN","CASHC1",164,0) I PNODE0="" Q 0 "RTN","CASHC1",165,0) S LABEL=$P(PNODE0,"^",1) "RTN","CASHC1",166,0) S INV=$P(PNODE0,"^",5) "RTN","CASHC1",167,0) S INV=$E(INV,1,$L(INV)-2)_EXT_"ID" "RTN","CASHC1",168,0) S TYPE=$P(PNODE0,"^",9),PARENT=$E(TYPE,2,255) "RTN","CASHC1",169,0) S TYPE=$$GETCLNM^CASHCN(TYPE,FLAGS,PACKAGE) "RTN","CASHC1",170,0) I TYPE="" Q 0 "RTN","CASHC1",171,0) I '$D(^oddDEF(TYPE)) Q 0 "RTN","CASHC1",172,0) S DESC=$G(^CASH(15050.11,FILE,1,15050.111,1)) "RTN","CASHC1",173,0) ; Change names if FLAGS["N" "RTN","CASHC1",174,0) I FLAGS["N" D "RTN","CASHC1",175,0) .N UIDNM,ROWID "RTN","CASHC1",176,0) .D GETNAMES^CASHCN(PARENT,"N","","","","",.UIDNM,.ROWID) "RTN","CASHC1",177,0) .S LABEL=$S(ROWID'="":ROWID,1:UIDNM) "RTN","CASHC1",178,0) .Q "RTN","CASHC1",179,0) ; "RTN","CASHC1",180,0) ; Restore CLASS "RTN","CASHC1",181,0) S CLASS=##CLASS(%Dictionary.ClassDefinition).%OpenId(CLNAME) "RTN","CASHC1",182,0) S NO=CLASS.Properties.Count() "RTN","CASHC1",183,0) S NO=NO+1 "RTN","CASHC1",184,0) ; "RTN","CASHC1",185,0) ; Create the Parent Relationship Property "RTN","CASHC1",186,0) S PROP=##CLASS(%Dictionary.PropertyDefinition).%New() "RTN","CASHC1",187,0) S PROP.Name=LABEL "RTN","CASHC1",188,0) S PROP.Calculated=0 "RTN","CASHC1",189,0) S PROP.Cardinality=$$SOCOUT^CASHR0(15050.111,.03,"P") "RTN","CASHC1",190,0) S PROP.Collection="" "RTN","CASHC1",191,0) S PROP.Description=DESC "RTN","CASHC1",192,0) S PROP.Inverse=INV "RTN","CASHC1",193,0) S PROP.Relationship=1 "RTN","CASHC1",194,0) S PROP.Required=0 "RTN","CASHC1",195,0) S PROP.SqlComputed=0 "RTN","CASHC1",196,0) S PROP.SqlComputeCode="" "RTN","CASHC1",197,0) S PROP.Type=TYPE "RTN","CASHC1",198,0) D CLASS.Properties.SetAt(PROP,NO) "RTN","CASHC1",199,0) ; Save Class definition so far "RTN","CASHC1",200,0) S OK=CLASS.%Save() "RTN","CASHC1",201,0) D CLASS.Properties.%UnSwizzleAt(NO) "RTN","CASHC1",202,0) I 'OK D ERRSAV^CASHCU("Property: "_NO_" - "_PROP.Name,$G(FILE),$G(FLAGS),$G(PACKAGE),$G(ID),$G(OWNER),"",$G(%objlasterror),.LIST) "RTN","CASHC1",203,0) K PROP "RTN","CASHC1",204,0) K CLASS "RTN","CASHC1",205,0) ; "RTN","CASHC1",206,0) ; Restore Parent Class "RTN","CASHC1",207,0) S CLASS=##CLASS(%Dictionary.ClassDefinition).%OpenId(TYPE) "RTN","CASHC1",208,0) S NO=CLASS.Properties.Count() "RTN","CASHC1",209,0) S NO=NO+1000 "RTN","CASHC1",210,0) ; "RTN","CASHC1",211,0) ; Create the Child Relationship Property "RTN","CASHC1",212,0) S PROP=##CLASS(%Dictionary.PropertyDefinition).%New() "RTN","CASHC1",213,0) S PROP.Name=INV "RTN","CASHC1",214,0) S PROP.Calculated=0 "RTN","CASHC1",215,0) S PROP.Cardinality=$$SOCOUT^CASHR0(15050.111,.03,"C") "RTN","CASHC1",216,0) S PROP.Collection="" "RTN","CASHC1",217,0) S PROP.Description="Relationship To Child File #: "_FILE_" (continuation "_EXT_")" "RTN","CASHC1",218,0) S PROP.Inverse=LABEL "RTN","CASHC1",219,0) S PROP.Relationship=1 "RTN","CASHC1",220,0) S PROP.Required=0 "RTN","CASHC1",221,0) S PROP.SqlComputed=0 "RTN","CASHC1",222,0) S PROP.SqlComputeCode="" "RTN","CASHC1",223,0) S PROP.Type=CLNAME "RTN","CASHC1",224,0) D CLASS.Properties.SetAt(PROP,NO) "RTN","CASHC1",225,0) ; Save Class definition so far "RTN","CASHC1",226,0) S OK=CLASS.%Save() "RTN","CASHC1",227,0) D CLASS.Properties.%UnSwizzleAt(NO) "RTN","CASHC1",228,0) I 'OK D ERRSAV^CASHCU("Property: "_NO_" - "_PROP.Name,$G(PARENT),$G(FLAGS),$G(PACKAGE),$G(ID),$G(OWNER),"",$G(%objlasterror),.LIST) "RTN","CASHC1",229,0) K PROP "RTN","CASHC1",230,0) K CLASS "RTN","CASHC1",231,0) ; "RTN","CASHC1",232,0) Q 1 "RTN","CASHC2") 0^9^B60203658 "RTN","CASHC2",1,0) CASHC2 ;ALB/MGC - Compiler for Cache version 5.0.x+ - Continued (Methods); 10/20/04@3:00:00 "RTN","CASHC2",2,0) ;;1.0;FM TO CACHE SQL;;Jul 08, 2005 "RTN","CASHC2",3,0) ; "RTN","CASHC2",4,0) ; IMPORTANT: These calls are for INTERNAL use only "RTN","CASHC2",5,0) ; "RTN","CASHC2",6,0) METHODS(FILE,FLAGS,PACKAGE,CLNAME,LIST,TMPLIST) ; Loop through and add any Methods "RTN","CASHC2",7,0) N CLASS,I,J,LASTMTD,METH,MTHD,OK "RTN","CASHC2",8,0) ; "RTN","CASHC2",9,0) ; Restore CLASS "RTN","CASHC2",10,0) S CLASS=##CLASS(%Dictionary.ClassDefinition).%OpenId(CLNAME) "RTN","CASHC2",11,0) S OK=1 "RTN","CASHC2",12,0) ; "RTN","CASHC2",13,0) S MTHD=0 "RTN","CASHC2",14,0) F I=1:1 S MTHD=$O(^CASH(15050.11,FILE,2,MTHD)) Q:'+MTHD D Q:'OK "RTN","CASHC2",15,0) .; The Get() methods are keyed by their associated Field # "RTN","CASHC2",16,0) .; If LIST array passed in check if the Field's Get() should be mapped "RTN","CASHC2",17,0) .I $D(LIST),'$D(LIST(FILE,MTHD)) Q "RTN","CASHC2",18,0) .; If TMPLIST array created check if the Field's Get() should be mapped "RTN","CASHC2",19,0) .I $D(TMPLIST),'$D(TMPLIST(MTHD)) Q "RTN","CASHC2",20,0) .N MNODE0,MODE,MTHNM "RTN","CASHC2",21,0) .S MNODE0=^CASH(15050.11,FILE,2,MTHD,0) "RTN","CASHC2",22,0) .S MTHNM=$P(MNODE0,"^",1) "RTN","CASHC2",23,0) .S MODE=$P(MNODE0,"^",3) I MODE'="" S MODE=$$SOCOUT^CASHR0(15050.112,.03,MODE) "RTN","CASHC2",24,0) .; Create new Method "RTN","CASHC2",25,0) .S METH(I)=##CLASS(%Dictionary.MethodDefinition).%New() "RTN","CASHC2",26,0) .S METH(I).Name=MTHNM "RTN","CASHC2",27,0) .S METH(I).ClassMethod=$P(MNODE0,"^",2) "RTN","CASHC2",28,0) .S METH(I).CodeMode=MODE "RTN","CASHC2",29,0) .S METH(I).Description=$P($G(^CASH(15050.11,FILE,2,MTHD,1)),"^",1) "RTN","CASHC2",30,0) .S METH(I).FormalSpec=$P($G(^CASH(15050.11,FILE,2,MTHD,2)),"^",1) "RTN","CASHC2",31,0) .S METH(I).Private=$P(MNODE0,"^",4) "RTN","CASHC2",32,0) .S METH(I).PublicList=$P($G(^CASH(15050.11,FILE,2,MTHD,3)),"^",1) "RTN","CASHC2",33,0) .S METH(I).ReturnType=$P(MNODE0,"^",5) "RTN","CASHC2",34,0) .; Loop through and add Code Lines (Implementation) "RTN","CASHC2",35,0) .F J=1:1 Q:'$D(^CASH(15050.11,FILE,2,MTHD,"CODE",J)) D "RTN","CASHC2",36,0) ..N LINE "RTN","CASHC2",37,0) ..S LINE=$G(^CASH(15050.11,FILE,2,MTHD,"CODE",J,0)) "RTN","CASHC2",38,0) ..; If CodeMode is not "expression", make sure lines have leading spaces "RTN","CASHC2",39,0) ..I MODE'="expression",$E(LINE)'=" " S LINE=" "_LINE "RTN","CASHC2",40,0) ..S OK=METH(I).Implementation.WriteLine(LINE) "RTN","CASHC2",41,0) ..Q "RTN","CASHC2",42,0) .D CLASS.Methods.SetAt(METH(I),I) "RTN","CASHC2",43,0) .; Save Class definition so far "RTN","CASHC2",44,0) .S OK=CLASS.%Save() "RTN","CASHC2",45,0) .; Rewind Implementation for subsequent saves (Use J to stop V4.1 compile errors) "RTN","CASHC2",46,0) .S J=METH(I).Implementation.Rewind() "RTN","CASHC2",47,0) .D CLASS.Methods.%UnSwizzleAt(I) "RTN","CASHC2",48,0) .I 'OK D ERRSAV^CASHCU("Method: "_I_" - "_METH(I).Name,$G(FILE),$G(FLAGS),$G(PACKAGE),$G(ID),$G(OWNER),"",$G(%objlasterror),.LIST) "RTN","CASHC2",49,0) .K METH(I) "RTN","CASHC2",50,0) .Q "RTN","CASHC2",51,0) ; "RTN","CASHC2",52,0) XML ; Add XMLDump() method if FLAGS["X" "RTN","CASHC2",53,0) I FLAGS["X" D "RTN","CASHC2",54,0) .N METHX,QRY "RTN","CASHC2",55,0) .; ExtentAlt Query "RTN","CASHC2",56,0) .; "RTN","CASHC2",57,0) .; NOTE: This is a workaround, as there appears to be a bug with Extent, or in fact "RTN","CASHC2",58,0) .; any SELECT %ID FROM Table query! They use the first index when really they should "RTN","CASHC2",59,0) .; just scan the Master map. Often the first index doesn't contain all the rows! "RTN","CASHC2",60,0) .; ExtentAlt uses SELECT %ID FROM Table WHERE %ID>0 to force it to use the Master Map. "RTN","CASHC2",61,0) .; "RTN","CASHC2",62,0) .; Add the ExtentAlt Query "RTN","CASHC2",63,0) .S QRY=##CLASS(%Dictionary.QueryDefinition).%New() "RTN","CASHC2",64,0) .S QRY.Name="ExtentAlt" "RTN","CASHC2",65,0) .S QRY.SqlQuery="SELECT %ID FROM "_$$GETSQLNM^CASHCN(FILE,FLAGS,PACKAGE)_$C(13,10)_" WHERE %ID>0" "RTN","CASHC2",66,0) .S QRY.Type="%SQLQuery" "RTN","CASHC2",67,0) .D QRY.Parameters.SetAt(1,"CONTAINID") "RTN","CASHC2",68,0) .D CLASS.Queries.SetAt(QRY,1) "RTN","CASHC2",69,0) .; Save Class definition so far "RTN","CASHC2",70,0) .S OK=CLASS.%Save() "RTN","CASHC2",71,0) .D CLASS.Queries.%UnSwizzleAt(1) "RTN","CASHC2",72,0) .I 'OK D ERRSAV^CASHCU("Query: ExtentAlt",$G(FILE),$G(FLAGS),$G(PACKAGE),$G(ID),$G(OWNER),"",$G(%objlasterror),.LIST) Q "RTN","CASHC2",73,0) .; "RTN","CASHC2",74,0) .; Create New Method "RTN","CASHC2",75,0) .S METHX=##CLASS(%Dictionary.MethodDefinition).%New() "RTN","CASHC2",76,0) .S METHX.Name="XMLDump" "RTN","CASHC2",77,0) .S METHX.ClassMethod=1 "RTN","CASHC2",78,0) .S METHX.CodeMode="code" "RTN","CASHC2",79,0) .S METHX.Description="Method to Export the entire table to XML"_$C(13,10)_"NOTE: Internal values are returned!" "RTN","CASHC2",80,0) .S METHX.FormalSpec="MAXROWS:%Library.Integer=1000" "RTN","CASHC2",81,0) .S METHX.Private=0 "RTN","CASHC2",82,0) .S METHX.PublicList="" "RTN","CASHC2",83,0) .S METHX.ReturnType="" "RTN","CASHC2",84,0) .S METHX.SqlProc=1 "RTN","CASHC2",85,0) .; Add Code Lines (Implementation) "RTN","CASHC2",86,0) .D METHX.Implementation.WriteLine(" S RS=##CLASS(%ResultSet).%New()") "RTN","CASHC2",87,0) .D METHX.Implementation.WriteLine(" S RS.ClassName="""_CLNAME_"""") "RTN","CASHC2",88,0) .D METHX.Implementation.WriteLine(" S RS.QueryName=""ExtentAlt""") "RTN","CASHC2",89,0) .D METHX.Implementation.WriteLine(" D RS.Execute()") "RTN","CASHC2",90,0) .D METHX.Implementation.WriteLine(" F I=1:1:MAXROWS Q:'RS.Next() D") "RTN","CASHC2",91,0) .D METHX.Implementation.WriteLine(" .S ID=RS.GetData(1)") "RTN","CASHC2",92,0) .D METHX.Implementation.WriteLine(" .S OBJ=##CLASS("_CLNAME_").%OpenId(ID)") "RTN","CASHC2",93,0) .D METHX.Implementation.WriteLine(" .D OBJ.XMLExport(,""literal,indent"")") "RTN","CASHC2",94,0) .D METHX.Implementation.WriteLine(" .K OBJ") "RTN","CASHC2",95,0) .D METHX.Implementation.WriteLine(" .Q") "RTN","CASHC2",96,0) .D METHX.Implementation.WriteLine(" D RS.Close()") "RTN","CASHC2",97,0) .D METHX.Implementation.WriteLine(" K RS") "RTN","CASHC2",98,0) .D METHX.Implementation.WriteLine(" Q") "RTN","CASHC2",99,0) .; Insert Method definition into CLASS "RTN","CASHC2",100,0) .; Variable I should already be the last method # plus 1! "RTN","CASHC2",101,0) .D CLASS.Methods.SetAt(METHX,I) "RTN","CASHC2",102,0) .; Save Class definition so far "RTN","CASHC2",103,0) .S OK=CLASS.%Save() "RTN","CASHC2",104,0) .; Rewind Implementation for subsequent saves "RTN","CASHC2",105,0) .D METHX.Implementation.Rewind() "RTN","CASHC2",106,0) .D CLASS.Methods.%UnSwizzleAt(I) "RTN","CASHC2",107,0) .I 'OK D ERRSAV^CASHCU("Method: XMLDump",$G(FILE),$G(FLAGS),$G(PACKAGE),$G(ID),$G(OWNER),"",$G(%objlasterror),.LIST) Q "RTN","CASHC2",108,0) .; "RTN","CASHC2",109,0) CSP .; Add OnPage() method if FLAGS["W" "RTN","CASHC2",110,0) .I FLAGS["W" D "RTN","CASHC2",111,0) ..N METHW "RTN","CASHC2",112,0) ..; Create New Method "RTN","CASHC2",113,0) ..S METHW=##CLASS(%Dictionary.MethodDefinition).%New() "RTN","CASHC2",114,0) ..S METHW.Name="OnPage" "RTN","CASHC2",115,0) ..S METHW.ClassMethod=1 "RTN","CASHC2",116,0) ..S METHW.CodeMode="code" "RTN","CASHC2",117,0) ..S METHW.Description="Overriden OnPage() method to call XMLDump()"_$C(13,10)_"NOTE: Internal values are returned!" "RTN","CASHC2",118,0) ..S METHW.FormalSpec="" "RTN","CASHC2",119,0) ..S METHW.Private=0 "RTN","CASHC2",120,0) ..S METHW.PublicList="" "RTN","CASHC2",121,0) ..S METHW.ReturnType="%Library.Status" "RTN","CASHC2",122,0) ..S METHW.ServerOnly=1 "RTN","CASHC2",123,0) ..S METHW.SqlProc=0 "RTN","CASHC2",124,0) ..; Add Code Lines (Implementation) "RTN","CASHC2",125,0) ..D METHW.Implementation.WriteLine(" S MAXROWS=%request.Get(""MAXROWS"")") "RTN","CASHC2",126,0) ..D METHW.Implementation.WriteLine(" I MAXROWS="""" S MAXROWS=1000") "RTN","CASHC2",127,0) ..D METHW.Implementation.WriteLine(" W """",!") "RTN","CASHC2",128,0) ..D METHW.Implementation.WriteLine(" W """",!") "RTN","CASHC2",129,0) ..D METHW.Implementation.WriteLine(" D ..XMLDump(MAXROWS)") "RTN","CASHC2",130,0) ..D METHW.Implementation.WriteLine(" W """",!") "RTN","CASHC2",131,0) ..D METHW.Implementation.WriteLine(" Quit $$$OK") "RTN","CASHC2",132,0) ..; Insert Method definition into CLASS "RTN","CASHC2",133,0) ..S I=I+1 "RTN","CASHC2",134,0) ..D CLASS.Methods.SetAt(METHW,I) "RTN","CASHC2",135,0) ..; Save Class definition so far "RTN","CASHC2",136,0) ..S OK=CLASS.%Save() "RTN","CASHC2",137,0) ..; Rewind Implementation for subsequent saves "RTN","CASHC2",138,0) ..D METHW.Implementation.Rewind() "RTN","CASHC2",139,0) ..D CLASS.Methods.%UnSwizzleAt(I) "RTN","CASHC2",140,0) ..I 'OK D ERRSAV^CASHCU("Method: OnPage",$G(FILE),$G(FLAGS),$G(PACKAGE),$G(ID),$G(OWNER),"",$G(%objlasterror),.LIST) "RTN","CASHC2",141,0) ..Q "RTN","CASHC2",142,0) .Q "RTN","CASHC2",143,0) ; "RTN","CASHC2",144,0) TRIGERR ; Add the TriggerErrorMsg private classmethod "RTN","CASHC2",145,0) ; Create New Method "RTN","CASHC2",146,0) N METHT "RTN","CASHC2",147,0) S METHT=##CLASS(%Dictionary.MethodDefinition).%New() "RTN","CASHC2",148,0) S METHT.Name="TriggerErrorMsg" "RTN","CASHC2",149,0) S METHT.ClassMethod=1 "RTN","CASHC2",150,0) S METHT.CodeMode="code" "RTN","CASHC2",151,0) S METHT.Description="Private Internal Method to interpret Trigger Error Message" "RTN","CASHC2",152,0) S METHT.FormalSpec="&CASHERR:%Library.String" "RTN","CASHC2",153,0) S METHT.Private=1 "RTN","CASHC2",154,0) S METHT.PublicList="" "RTN","CASHC2",155,0) S METHT.ReturnType="%Library.String" "RTN","CASHC2",156,0) S METHT.SqlProc=0 "RTN","CASHC2",157,0) ; Add Code Lines (Implementation) "RTN","CASHC2",158,0) D METHT.Implementation.WriteLine(" D MSG^DIALOG(""ABET"",.ERR,"""","""",""CASHERR"")") "RTN","CASHC2",159,0) D METHT.Implementation.WriteLine(" S %msg=ERR(1)") "RTN","CASHC2",160,0) D METHT.Implementation.WriteLine(" I ERR>1 F I=2:1:ERR S %msg=%msg_$C(13,10)_ERR(I)") "RTN","CASHC2",161,0) D METHT.Implementation.WriteLine(" Q %msg") "RTN","CASHC2",162,0) ; Insert Method definition into CLASS "RTN","CASHC2",163,0) ; Variable I should already be the last method # plus 1! "RTN","CASHC2",164,0) D CLASS.Methods.SetAt(METHT,I) "RTN","CASHC2",165,0) S I=I+1 "RTN","CASHC2",166,0) ; Save Class definition so far "RTN","CASHC2",167,0) S OK=CLASS.%Save() "RTN","CASHC2",168,0) ; Rewind Implementation for subsequent saves "RTN","CASHC2",169,0) D METHT.Implementation.Rewind() "RTN","CASHC2",170,0) D CLASS.Methods.%UnSwizzleAt(I) "RTN","CASHC2",171,0) I 'OK D ERRSAV^CASHCU("Method: TriggerErrorMsg",$G(FILE),$G(FLAGS),$G(PACKAGE),$G(ID),$G(OWNER),"",$G(%objlasterror),.LIST) Q "RTN","CASHC2",172,0) ; "RTN","CASHC2",173,0) Q OK "RTN","CASHC3") 0^10^B80053616 "RTN","CASHC3",1,0) CASHC3 ;ALB/MGC - Compiler for Cache version 5.0.x+ - Continued (Triggers); 10/20/04@3:00:00 "RTN","CASHC3",2,0) ;;1.0;FM TO CACHE SQL;;Jul 08, 2005 "RTN","CASHC3",3,0) ; "RTN","CASHC3",4,0) ; IMPORTANT: These calls are for INTERNAL use only "RTN","CASHC3",5,0) ; "RTN","CASHC3",6,0) TRIGGERS(FILE,FLAGS,CLNAME,UIDNM,LIST,TMPLIST) ; Add Delete/Insert/Update Triggers "RTN","CASHC3",7,0) N CLASS,CODE,CRLF,INSCODE,OK,TRIG,UPDCODE "RTN","CASHC3",8,0) ; "RTN","CASHC3",9,0) ; Restore CLASS "RTN","CASHC3",10,0) S CLASS=##CLASS(%Dictionary.ClassDefinition).%OpenId(CLNAME) "RTN","CASHC3",11,0) S CRLF=$C(13,10) "RTN","CASHC3",12,0) S OK=1 "RTN","CASHC3",13,0) ; "RTN","CASHC3",14,0) DELETE ; Create new Before Delete Trigger "RTN","CASHC3",15,0) S TRIG=##CLASS(%Dictionary.TriggerDefinition).%New() "RTN","CASHC3",16,0) S TRIG.Name="BeforeDelete" "RTN","CASHC3",17,0) S TRIG.Description="Before Delete Trigger - Calls Classic FileMan API: ^DIK" "RTN","CASHC3",18,0) S TRIG.Event="DELETE" "RTN","CASHC3",19,0) S TRIG.Time="BEFORE" "RTN","CASHC3",20,0) ; Add Code "RTN","CASHC3",21,0) S CODE=" N %,%H,DA,DIC,DIK,DIQUIET,DISYS,DT,DTIME,DUZ,IO,U,X,Y" "RTN","CASHC3",22,0) S CODE=CODE_CRLF_" S %SkipFiling=1" "RTN","CASHC3",23,0) S CODE=CODE_CRLF_" S DIQUIET=1 D DT^DICRW" "RTN","CASHC3",24,0) S CODE=CODE_CRLF_" S IENS={IENS}" "RTN","CASHC3",25,0) S CODE=CODE_CRLF_" D DA^DILF(IENS,.DA)" "RTN","CASHC3",26,0) S CODE=CODE_CRLF_" S DIK=$$ROOT^DILFD("_FILE_",IENS)" "RTN","CASHC3",27,0) S CODE=CODE_CRLF_" D ^DIK" "RTN","CASHC3",28,0) S TRIG.Code=CODE "RTN","CASHC3",29,0) ; Insert Trigger definition into CLASS "RTN","CASHC3",30,0) D CLASS.Triggers.SetAt(TRIG,1) "RTN","CASHC3",31,0) S OK=CLASS.%Save() "RTN","CASHC3",32,0) D CLASS.Triggers.%UnSwizzleAt(1) "RTN","CASHC3",33,0) I 'OK D ERRSAV^CASHCU("Trigger: BeforeDelete",$G(FILE),$G(FLAGS),$G(PACKAGE),$G(ID),$G(OWNER),"",$G(%objlasterror),.LIST) Q OK "RTN","CASHC3",34,0) K TRIG "RTN","CASHC3",35,0) ; "RTN","CASHC3",36,0) ; Generate Insert and Update Code "RTN","CASHC3",37,0) D CODE(FILE,FLAGS,UIDNM,.LIST,.TMPLIST,.INSCODE,.UPDCODE) "RTN","CASHC3",38,0) ; "RTN","CASHC3",39,0) INSERT ; Create new Before Insert Trigger "RTN","CASHC3",40,0) S TRIG=##CLASS(%Dictionary.TriggerDefinition).%New() "RTN","CASHC3",41,0) S TRIG.Name="BeforeInsert" "RTN","CASHC3",42,0) S TRIG.Description="Before Insert Trigger - Calls Database Server API: UPDATE^DIE" "RTN","CASHC3",43,0) S TRIG.Event="INSERT" "RTN","CASHC3",44,0) S TRIG.Time="BEFORE" "RTN","CASHC3",45,0) ; Add Code to Trigger "RTN","CASHC3",46,0) S TRIG.Code=INSCODE "RTN","CASHC3",47,0) ; Insert Trigger definition into CLASS "RTN","CASHC3",48,0) D CLASS.Triggers.SetAt(TRIG,2) "RTN","CASHC3",49,0) S OK=CLASS.%Save() "RTN","CASHC3",50,0) D CLASS.Triggers.%UnSwizzleAt(2) "RTN","CASHC3",51,0) I 'OK D ERRSAV^CASHCU("Trigger: BeforeInsert",$G(FILE),$G(FLAGS),$G(PACKAGE),$G(ID),$G(OWNER),"",$G(%objlasterror),.LIST) Q OK "RTN","CASHC3",52,0) K TRIG "RTN","CASHC3",53,0) ; "RTN","CASHC3",54,0) UPDATE ; Create new Before Update Trigger "RTN","CASHC3",55,0) S TRIG=##CLASS(%Dictionary.TriggerDefinition).%New() "RTN","CASHC3",56,0) S TRIG.Name="BeforeUpdate" "RTN","CASHC3",57,0) S TRIG.Description="Before Update Trigger - Calls Database Server API: FILE^DIE" "RTN","CASHC3",58,0) S TRIG.Event="UPDATE" "RTN","CASHC3",59,0) S TRIG.Time="BEFORE" "RTN","CASHC3",60,0) ; Add Code to Trigger "RTN","CASHC3",61,0) S TRIG.Code=UPDCODE "RTN","CASHC3",62,0) ; Insert Trigger definition into CLASS "RTN","CASHC3",63,0) D CLASS.Triggers.SetAt(TRIG,3) "RTN","CASHC3",64,0) S OK=CLASS.%Save() "RTN","CASHC3",65,0) D CLASS.Triggers.%UnSwizzleAt(3) "RTN","CASHC3",66,0) I 'OK D ERRSAV^CASHCU("Trigger: BeforeUpdate",$G(FILE),$G(FLAGS),$G(PACKAGE),$G(ID),$G(OWNER),"",$G(%objlasterror),.LIST) "RTN","CASHC3",67,0) K TRIG "RTN","CASHC3",68,0) ; "RTN","CASHC3",69,0) Q OK "RTN","CASHC3",70,0) ; "RTN","CASHC3",71,0) CODE(FILE,FLAGS,UIDNM,LIST,TMPLIST,INSCODE,UPDCODE) ; Generate Insert and Update Code "RTN","CASHC3",72,0) ; Abstracted here to make just one pass through the fields "RTN","CASHC3",73,0) ; "RTN","CASHC3",74,0) N CODE,CRLF,FIELD,FTYPE,PARENT,PFLD,SQLNM "RTN","CASHC3",75,0) S CRLF=$C(13,10) "RTN","CASHC3",76,0) S FTYPE=$P($G(^CASH(15050.11,FILE,0)),"^",4) "RTN","CASHC3",77,0) S PFLD=$P($G(^CASH(15050.11,FILE,0)),"^",5) "RTN","CASHC3",78,0) ; "RTN","CASHC3",79,0) ; For Word Processing Files "RTN","CASHC3",80,0) I FTYPE="W" D "RTN","CASHC3",81,0) .N PFILE,PFTYPE "RTN","CASHC3",82,0) .S SQLNM=$$SQLNM(FILE,.01) "RTN","CASHC3",83,0) .S PARENT=$$PARENT(FILE,FLAGS,.PFILE,.PFTYPE) "RTN","CASHC3",84,0) .; Common Code "RTN","CASHC3",85,0) .S CODE=" N CASHARR,DISYS,DT,DTIME,DUZ,CASHERR,IENS,I,IO,U" "RTN","CASHC3",86,0) .S CODE=CODE_CRLF_" S %SkipFiling=1" "RTN","CASHC3",87,0) .; Create INSCODE and UPDCODE "RTN","CASHC3",88,0) .S INSCODE=CODE_CRLF_" I {"_SQLNM_"}="""" S %ok=0,%msg="""_$TR(SQLNM,"""","")_" must be entered"" Q" "RTN","CASHC3",89,0) .S UPDCODE=CODE_CRLF_" I '{"_SQLNM_"*C} Q" "RTN","CASHC3",90,0) .; More common code "RTN","CASHC3",91,0) .S CODE=$S(PFTYPE="F":" S IENS="_PARENT_"_"",""",1:" S IENS="""" F I=$L("_PARENT_",""||""):-1:1 S IENS=IENS_$P("_PARENT_",""||"",I)_"",""") "RTN","CASHC3",92,0) .S CODE=CODE_CRLF_" D GETWP^CASHR("_PFILE_","_PFLD_","_PARENT_",.CASHARR)" "RTN","CASHC3",93,0) .; Update INSCODE and UPDCODE "RTN","CASHC3",94,0) .S INSCODE=INSCODE_CRLF_CODE_CRLF_" S CASHARR($O(CASHARR(""""),-1)+1)={"_SQLNM_"}" "RTN","CASHC3",95,0) .S UPDCODE=UPDCODE_CRLF_CODE_CRLF_" S CASHARR({"_UIDNM_"})={"_SQLNM_"}" "RTN","CASHC3",96,0) .; Last section of common code "RTN","CASHC3",97,0) .S CODE=" D WP^DIE("_PFILE_",IENS,"_PFLD_","""",""CASHARR"",""CASHERR"")" "RTN","CASHC3",98,0) .S CODE=CODE_CRLF_" I $D(CASHERR) S %ok=0,%msg=..TriggerErrorMsg(.CASHERR)" "RTN","CASHC3",99,0) .S INSCODE=INSCODE_CRLF_CODE "RTN","CASHC3",100,0) .S UPDCODE=UPDCODE_CRLF_CODE "RTN","CASHC3",101,0) .Q "RTN","CASHC3",102,0) ; "RTN","CASHC3",103,0) ; For Top-level Files and Sub-files "RTN","CASHC3",104,0) I FTYPE'="W" D "RTN","CASHC3",105,0) .; Inserts "RTN","CASHC3",106,0) .S INSCODE=" N CASHARR,DISYS,DT,DTIME,DUZ,CASHERR,CASHFDA,CASHIEN,IENS,I,IO,U" "RTN","CASHC3",107,0) .S INSCODE=INSCODE_CRLF_" S %SkipFiling=1" "RTN","CASHC3",108,0) .S INSCODE=INSCODE_CRLF_" S CASHIEN(1)={"_UIDNM_"}" "RTN","CASHC3",109,0) .S INSCODE=INSCODE_CRLF_" S IENS=""+1,""" "RTN","CASHC3",110,0) .; Updates "RTN","CASHC3",111,0) .S UPDCODE=" N CASHARR,DISYS,DT,DTIME,DUZ,CASHERR,CASHFDA,IENS,I,IO,U" "RTN","CASHC3",112,0) .S UPDCODE=UPDCODE_CRLF_" S %SkipFiling=1" "RTN","CASHC3",113,0) .S UPDCODE=UPDCODE_CRLF_" S IENS={"_UIDNM_"}_"",""" "RTN","CASHC3",114,0) .; For Sub-files use Parent reference to get full IENS "RTN","CASHC3",115,0) .I FTYPE="S" D "RTN","CASHC3",116,0) ..N PFILE "RTN","CASHC3",117,0) ..S PARENT=$$PARENT(FILE,FLAGS) "RTN","CASHC3",118,0) ..S CODE=" F I=$L("_PARENT_",""||""):-1:1 S IENS=IENS_$P("_PARENT_",""||"",I)_"",""" "RTN","CASHC3",119,0) ..S INSCODE=INSCODE_CRLF_CODE "RTN","CASHC3",120,0) ..S UPDCODE=UPDCODE_CRLF_CODE "RTN","CASHC3",121,0) ..Q "RTN","CASHC3",122,0) .; Add lines for Data fields "RTN","CASHC3",123,0) .S FIELD="" "RTN","CASHC3",124,0) .F S FIELD=$O(^CASH(15050.11,FILE,1,"C","D",FIELD)) Q:FIELD="" D "RTN","CASHC3",125,0) ..I $D(LIST),'$D(LIST(FILE,FIELD)) Q "RTN","CASHC3",126,0) ..I $D(TMPLIST),'$D(TMPLIST(FIELD)) Q "RTN","CASHC3",127,0) ..S SQLNM=$$SQLNM(FILE,FIELD) "RTN","CASHC3",128,0) ..S INSCODE=INSCODE_CRLF_" S:{"_SQLNM_"}'="""" CASHFDA("_FILE_",IENS,"_FIELD_")={"_SQLNM_"}" "RTN","CASHC3",129,0) ..S UPDCODE=UPDCODE_CRLF_" S:{"_SQLNM_"*C} CASHFDA("_FILE_",IENS,"_FIELD_")={"_SQLNM_"}" "RTN","CASHC3",130,0) ..Q "RTN","CASHC3",131,0) .; Add lines for Pointer fields (if "E" or "P" FLAG passed in) "RTN","CASHC3",132,0) .I FLAGS["E"!(FLAGS["P") D "RTN","CASHC3",133,0) ..S FIELD="" "RTN","CASHC3",134,0) ..F S FIELD=$O(^CASH(15050.11,FILE,1,"C","P",FIELD)) Q:FIELD="" D "RTN","CASHC3",135,0) ...I $D(LIST),'$D(LIST(FILE,FIELD)) Q "RTN","CASHC3",136,0) ...I $D(TMPLIST),'$D(TMPLIST(FIELD)) Q "RTN","CASHC3",137,0) ...N NAME,PFILE "RTN","CASHC3",138,0) ...S NAME=$P($G(^CASH(15050.11,FILE,1,FIELD,0)),"^",1)_"ID" "RTN","CASHC3",139,0) ...S PFILE=$P($G(^CASH(15050.11,FILE,1,FIELD,1,1,0)),"^",2) "RTN","CASHC3",140,0) ...S SQLNM=$$SQLNM(FILE,FIELD) "RTN","CASHC3",141,0) ...; If both Flags passed, take the ID in preference "RTN","CASHC3",142,0) ...I FLAGS["E",FLAGS["P" D Q "RTN","CASHC3",143,0) ....; Insert code "RTN","CASHC3",144,0) ....S INSCODE=INSCODE_CRLF_" I {"_NAME_"}'="""",$$EXISTS^CASHR("_PFILE_",{"_NAME_"}) {" "RTN","CASHC3",145,0) ....S INSCODE=INSCODE_CRLF_" S CASHFDA("_FILE_",IENS,"_FIELD_")={"_NAME_"}" "RTN","CASHC3",146,0) ....S INSCODE=INSCODE_CRLF_" } ElseIf {"_SQLNM_"}'="""" {" "RTN","CASHC3",147,0) ....S INSCODE=INSCODE_CRLF_" S CASHFDA("_FILE_",IENS,"_FIELD_")={"_SQLNM_"}" "RTN","CASHC3",148,0) ....S INSCODE=INSCODE_CRLF_" }" "RTN","CASHC3",149,0) ....; Update code "RTN","CASHC3",150,0) ....S UPDCODE=UPDCODE_CRLF_" I {"_NAME_"*C},({"_NAME_"}="""")||($$EXISTS^CASHR("_PFILE_",{"_NAME_"})) {" "RTN","CASHC3",151,0) ....S UPDCODE=UPDCODE_CRLF_" S CASHFDA("_FILE_",IENS,"_FIELD_")={"_NAME_"}" "RTN","CASHC3",152,0) ....S UPDCODE=UPDCODE_CRLF_" } ElseIf {"_SQLNM_"*C} {" "RTN","CASHC3",153,0) ....S UPDCODE=UPDCODE_CRLF_" S CASHFDA("_FILE_",IENS,"_FIELD_")={"_SQLNM_"}" "RTN","CASHC3",154,0) ....S UPDCODE=UPDCODE_CRLF_" }" "RTN","CASHC3",155,0) ....Q "RTN","CASHC3",156,0) ...; Validate ID "RTN","CASHC3",157,0) ...I FLAGS["P" D Q "RTN","CASHC3",158,0) ....S INSCODE=INSCODE_CRLF_" I {"_NAME_"}'="""",$$EXISTS^CASHR("_PFILE_",{"_NAME_"}) S CASHFDA("_FILE_",IENS,"_FIELD_")={"_NAME_"}" "RTN","CASHC3",159,0) ....S UPDCODE=UPDCODE_CRLF_" I {"_NAME_"*C},({"_NAME_"}="""")||($$EXISTS^CASHR("_PFILE_",{"_NAME_"})) S CASHFDA("_FILE_",IENS,"_FIELD_")={"_NAME_"}" "RTN","CASHC3",160,0) ....Q "RTN","CASHC3",161,0) ...; Update validated expansion "RTN","CASHC3",162,0) ...S INSCODE=INSCODE_CRLF_" S:{"_SQLNM_"}'="""" CASHFDA("_FILE_",IENS,"_FIELD_")={"_SQLNM_"}" "RTN","CASHC3",163,0) ...S UPDCODE=UPDCODE_CRLF_" S:{"_SQLNM_"*C} CASHFDA("_FILE_",IENS,"_FIELD_")={"_SQLNM_"}" "RTN","CASHC3",164,0) ...Q "RTN","CASHC3",165,0) ..Q "RTN","CASHC3",166,0) .; Inserts "RTN","CASHC3",167,0) .S INSCODE=INSCODE_CRLF_" I '$D(CASHFDA) S %ok=0,%msg="""_$P($G(^CASH(15050.11,FILE,1,.01,0)),"^",1)_" must be entered"" Q" "RTN","CASHC3",168,0) .S INSCODE=INSCODE_CRLF_" D UPDATE^DIE("""",""CASHFDA"",""CASHIEN"",""CASHERR"")" "RTN","CASHC3",169,0) .S INSCODE=INSCODE_CRLF_" I $D(CASHERR) S %ok=0,%msg=..TriggerErrorMsg(.CASHERR)" "RTN","CASHC3",170,0) .; Updates "RTN","CASHC3",171,0) .S UPDCODE=UPDCODE_CRLF_" I $D(CASHFDA) {" "RTN","CASHC3",172,0) .S UPDCODE=UPDCODE_CRLF_" D FILE^DIE("""",""CASHFDA"",""CASHERR"")" "RTN","CASHC3",173,0) .S UPDCODE=UPDCODE_CRLF_" I $D(CASHERR) S %ok=0,%msg=..TriggerErrorMsg(.CASHERR)" "RTN","CASHC3",174,0) .S UPDCODE=UPDCODE_CRLF_" }" "RTN","CASHC3",175,0) .; If WP Fields are present, replace "+1" in IENS. These will be updates not inserts "RTN","CASHC3",176,0) .I $D(^CASH(15050.11,FILE,1,"C","W")) S INSCODE=INSCODE_CRLF_" S $P(IENS,"","",1)=CASHIEN(1)" "RTN","CASHC3",177,0) .; Add blocks for WP Fields "RTN","CASHC3",178,0) .S FIELD="" "RTN","CASHC3",179,0) .F S FIELD=$O(^CASH(15050.11,FILE,1,"C","W",FIELD)) Q:FIELD="" D "RTN","CASHC3",180,0) ..I $D(LIST),'$D(LIST(FILE,FIELD)) Q "RTN","CASHC3",181,0) ..I $D(TMPLIST),'$D(TMPLIST(FIELD)) Q "RTN","CASHC3",182,0) ..S SQLNM=$$SQLNM(FILE,FIELD) "RTN","CASHC3",183,0) ..; Common code "RTN","CASHC3",184,0) ..S CODE=" K CASHARR F I=1:1:$L({"_SQLNM_"},$C(13,10)) S CASHARR(I)=$P({"_SQLNM_"},$C(13,10),I)" "RTN","CASHC3",185,0) ..S CODE=CODE_CRLF_" D WP^DIE("_FILE_",IENS,"_FIELD_","""",""CASHARR"",""CASHERR"")" "RTN","CASHC3",186,0) ..S CODE=CODE_CRLF_" I $D(CASHERR) S %ok=0,%msg=..TriggerErrorMsg(.CASHERR)" "RTN","CASHC3",187,0) ..S CODE=CODE_CRLF_" }" "RTN","CASHC3",188,0) ..; Inserts "RTN","CASHC3",189,0) ..S INSCODE=INSCODE_CRLF_" I {"_SQLNM_"}'="""" {"_CRLF_CODE "RTN","CASHC3",190,0) ..; Updates "RTN","CASHC3",191,0) ..S UPDCODE=UPDCODE_CRLF_" I {"_SQLNM_"*C} {"_CRLF_CODE "RTN","CASHC3",192,0) ..Q "RTN","CASHC3",193,0) .Q "RTN","CASHC3",194,0) ; "RTN","CASHC3",195,0) SQLNM(FILE,FIELD) ; Get SQL Name for a Field "RTN","CASHC3",196,0) N SQLNM "RTN","CASHC3",197,0) S SQLNM=$P($G(^CASH(15050.11,FILE,1,FIELD,3)),"^",2) "RTN","CASHC3",198,0) I SQLNM="" S SQLNM=$P($G(^CASH(15050.11,FILE,1,FIELD,0)),"^",1) "RTN","CASHC3",199,0) ; Add quotes if prefixed with underscore. Required for {} syntax. "RTN","CASHC3",200,0) I $E(SQLNM)="_" S SQLNM=""""_SQLNM_"""" "RTN","CASHC3",201,0) Q SQLNM "RTN","CASHC3",202,0) ; "RTN","CASHC3",203,0) PARENT(FILE,FLAGS,PFILE,PFTYPE) ; Get details for the Parent Reference "RTN","CASHC3",204,0) N PNAME "RTN","CASHC3",205,0) S PFILE=$P($P($G(^CASH(15050.11,FILE,1,15050.111,0)),"^",9),"#",2) "RTN","CASHC3",206,0) S PFTYPE=$P($G(^CASH(15050.11,PFILE,0)),"^",4) "RTN","CASHC3",207,0) ; If FLAGS["N" get alternative Parent reference "RTN","CASHC3",208,0) I FLAGS["N" D Q PNAME "RTN","CASHC3",209,0) .N UIDNM,ROWID "RTN","CASHC3",210,0) .D GETNAMES^CASHCN(PFILE,"N","","","","",.UIDNM,.ROWID) "RTN","CASHC3",211,0) .I ROWID'="" S PNAME="{"_ROWID_"}" Q "RTN","CASHC3",212,0) .S PNAME="{"_UIDNM_"}" "RTN","CASHC3",213,0) .Q "RTN","CASHC3",214,0) S PNAME="{"_$$SQLNM(FILE,15050.111)_"}" "RTN","CASHC3",215,0) Q PNAME "RTN","CASHC4") 0^11^B59935224 "RTN","CASHC4",1,0) CASHC4 ;ALB/MGC - Compiler for Cache version 5.0.x+ - Continued (Storage Maps); 10/20/04@3:00:00 "RTN","CASHC4",2,0) ;;1.0;FM TO CACHE SQL;;Jul 08, 2005 "RTN","CASHC4",3,0) ; "RTN","CASHC4",4,0) ; IMPORTANT: These calls are for INTERNAL use only "RTN","CASHC4",5,0) ; "RTN","CASHC4",6,0) STORAGE(FILE,FLAGS,PACKAGE,ID,CLNAME,UIDNM,LIST,TMPLIST) ; Create the Storage "RTN","CASHC4",7,0) N CLASS,OK,STORAGE "RTN","CASHC4",8,0) ; "RTN","CASHC4",9,0) ; Restore CLASS "RTN","CASHC4",10,0) S CLASS=##CLASS(%Dictionary.ClassDefinition).%OpenId(CLNAME) "RTN","CASHC4",11,0) ; "RTN","CASHC4",12,0) ; Create Storage Definition "RTN","CASHC4",13,0) S STORAGE=##CLASS(%Dictionary.StorageDefinition).%New() "RTN","CASHC4",14,0) S STORAGE.Name="FileMan" "RTN","CASHC4",15,0) S STORAGE.Type="%CacheSQLStorage" "RTN","CASHC4",16,0)